You are here:

Excel/Checking for duplicates-try#2

Advertisement


Question
QUESTION: Tom: Sorry about the vagueness.  Let me try again.

The workbook is on manual calc.

b1:b10 has hlookup formulas referencing a1:a10 (a1 for b1 a2 for b2 etc) to a much larger range elsewhere (z1:z50). It's OK that the names are duplicated in this larger range set.

After the sheet calculates there might be a duplicate name(s) anywhere in b1:b10.  The returned names (results?) must all be independent (10 unique names (results)).

So I need this macro to verify no duplicates occurred in b1:b10.

If it finds a duplicate I need it to change the variable in the "A" column and refire the hlookup formula and then check again if there are duplicates.  This can take many iterations until all 10 names nb1:b10 are unique.

BUT, when it changes the variable in "A", it must change it in sequential order...if "1st" it must change it to "2nd", if "2nd" it must change it to "3rd" (3rd to blank, blank to 1st).  I dont want a bunch of random changes in "A" until it loops through without a duplicate.

Hope this is better.

Pete

Tom: Thanks for all your help in the past.

Two columns of data
a1:a10 has either text "1st", "2nd", "3rd" or a blank.
b1:b10 has text like: "apple", "orange", "cherry" etc.
Note: the quotes are not actually in the cell field.

I want a loop that starts at "b1" and drives down to b2, b3 sequentially etc and if it finds a duplicate it stops (say this happens at b5) and looks at a5 (directly to the left) and thereafter changes whats there (a5) to another text sequentially (if 1st then 2nd if 2nd then 3rd if 3rd then blank if blank then 1st).

Then since the sheets are not on automatic calc I need a recalc of the cell (b5 in this example).

Now it's got to start over at b1 again and drill down again until it can get to b10 without a duplicate.

Then its got to do this starting at b2 and drilling down without duplicates and so on until it can start at b9 without a duplicate at b10.

Can this be done?

Pete

ANSWER: Pete,

I tested this using a the rand()  function in B1:B10 and it stopped when I had a unique set of numbers in B1:B10.   It changed the values in A1:A10 where it changed numbers in B1:B10.  hopefully it does what you describe.   I also put in a safety so it will stop after 1000 trips through B1:B10 if it hasn't generated a solution.   

Sub ABC()
Dim rB As Range, rA As Range
Dim bDup As Boolean
Dim cell As Range, cellA As Range
Dim rB1 As Range
Dim cnt As Long
Set rB = Range("B1:B10")
Set rA = Range("A1:A10")
cnt = 0
Do
bDup = False
For Each cell In rB
  If cell.Row <> 1 Then
    Set rB1 = Range("B1", cell.Offset(-1, 0))
    If Application.CountIf(rB1, cell) > 0 Then
       bDup = True
       Set cellA = cell.Offset(0, -1)
       Select Case cellA
         Case "1st"
         cellA.Value = "2nd"
         Case "2nd"
         cellA.Value = "3rd"
         Case "3rd"
         cellA.ClearContents
         Case Else
         cellA.Value = "1st"
      End Select
      cell.Calculate
      Exit For
    End If
  End If
Next
cnt = cnt + 1
Loop While bDup And cnt < 1000
End Sub

---------- FOLLOW-UP ----------

QUESTION: Tom: Your talents are amazing.  It works.

I don't understand what this line of code does.

Set rB1 = Range("B1", cell.Offset(-1, 0))

Pete

ANSWER: Pete,

it sets a reference (rB1) to the range of cells from B1 up to but not including the cell we are looking at (cell).  Used in the countif function to determine if this cell is a duplicate or not.

--
Regards,
Tom Ogilvy
 

---------- FOLLOW-UP ----------

QUESTION: Tom: I assume this checks for dupes at the top going down...b1 to b10 can it go in reverse...b10 up to b1?

Answer
Pete,

didn't take one of the END IF statements out - try this revision:

Sub ABC_Reverse()

Dim bDup As Boolean
Dim cell As Range, cellA As Range
Dim rB1 As Range
Dim cnt As Long

cnt = 0
Do
bDup = False
For i = 10 To 2 Step -1
    Set cell = Cells(i, "B")
    Set rB1 = Range("B1", Cells(i - 1, "B"))
    If Application.CountIf(rB1, cell) > 0 Then
       bDup = True
       Set cellA = cell.Offset(0, -1)
       Select Case cellA
         Case "1st"
         cellA.Value = "2nd"
         Case "2nd"
         cellA.Value = "3rd"
         Case "3rd"
         cellA.ClearContents
         Case Else
         cellA.Value = "1st"
      End Select
      cell.Calculate
      Exit For
    End If
Next
cnt = cnt + 1
Loop While bDup And cnt < 1000
End Sub
--
Regards,
Tom Ogilvy

About Excel
This topic answers questions related to Microsoft Excel spreadsheet (or workbook) stand-alone or Mircrosoft Office Excel including Excel 2003, Excel 2007, Office 2000, and Office XP. You can get Excel help on Excel formulas(or functions), Excell macros, charting in Excel, advanced features, and the general use of Excel. This does not provide a general Excel tutorial nor the basics of using a spreadsheet. It provides specific answers to using Microsoft Excel only. If you do not see your Excel question answered in this area then please ask an Excel question here

Excel

All Answers


Answers by Expert:


Ask Experts

Volunteer


Tom Ogilvy

Expertise

Selected as an Excel MVP by Microsoft since 1999. Answering Excel questions in Allexperts since its inception in 2001. Able to answer questions on almost all aspects of Excel's internal capabilities. If seeking a VBA solution, please specify that in your question itself so I give you the answer you want. [Excel has weak protection - if you are distributing an application, I don't answer questions on how to protect your project from your users.]

Experience

Extensive experience.

Education/Credentials
Master of Science (MS) degree Operations Research (ORSA)

Awards and Honors
Microsoft MVP in Excel.

©2016 About.com. All rights reserved.