Macro Question - Find duplicate and make unique

Hi,

I'm not sure if this is possible but I need to make a macro that searches a column for duplicates. If it finds a duplicate I need to it to make it unique by adding a .1 at the end. I would also want it to continue to add unique identifiers if there are say 5 duplicates of the same field.

For example it would find 5185 in the column five times. It would then proceed to change the duplicates to 5185.1 - 5185.2 - 5186.3 - 5185.4 - 5185.5

Is this possible to do?

Thanks!

Is the source column always going to start out with integers? If so, it will be easier. There are several approaches to searching the column. Is it acceptable if the uniquely tagged cells are formatted as text? Or do they need to be floating point numbers? Will the number of unique tags ever roll over to "10"? If so, you'll have a problem with leading and trailing zeros if you don't make them text strings. Also, sorting could be problematic depending on the format.

Quote:

---

Is the source column always going to start out with integers?

---

Yes the column will always be numbers. They are record numbers so they range from single digits up to five digits in length.

Quote:

---

Is it acceptable if the uniquely tagged cells are formatted as text? Or do they need to be floating point numbers?

---

Formatting them as text will not be a problem.

Quote:

---

Will the number of unique tags ever roll over to "10"?

---

It is possible yes.

VB Code:

Public Sub MarkDups()
    Dim tmp As String
    Dim cntr As Integer
    
    For x = 1 To 30 'rows in my test
        tmp = Range("A" & x).Text
        cntr = 1
        For y = 1 To 30
            If y <> x Then
                If tmp = Range("A" & y).Text Then
                    Range("A" & y) = Range("A" & y) & "." & cntr
                    cntr = cntr + 1
                End If
            End If
        Next
    Next
End Sub

That works great thanks!

One other question. Is it possible for the code to know when the column is done and stop looking for duplicates. I need something more dynamic so that there isn’t any clean up needed afterword.

That may work great for 30 items, but try it for 50,000! It may take awhile! Each step of X eliminates that row as a possible duplicate, so I think you can change the following line:

Code:

---

For y = 1 To 30
'to
For y = x to 30

---

That way the inner loop won't re-scan items that are already eliminated as duplicates.

make that:

Code:

---

For y = x + 1 To 30

---

and eliminate the test "If y <> x".

The code which static wrote, didnt produce the right output...I would rather prefer the following code :

VB Code:

Public Sub MarkDups()
    Dim tmp As String
    Dim cntr As Integer
    
    For x = 1 To 30 'rows in my test
        tmp = Range("A" & x).Text
        cntr = 1
                    
       
        For y = x + 1 To 30
                            
                If tmp = Range("A" & y).Text Then
                        If cntr Mod 10 = 0 Then
                        cntr = cntr + 1
                        End If
                    Range("A" & y) = Range("A" & y) & "." & cntr
                    cntr = cntr + 1
                End If
        Next
    Next
End Sub

Is there a way for it to check if the cell is blank and if it is then stop or not do anything?

Check if you want this :

VB Code:

Public Sub MarkDups()
    Dim tmp As String
    Dim cntr As Integer
    
    For x = 1 To 30 'rows in my test
        tmp = Range("A" & x).Text
        cntr = 1
                    
        If tmp = "" Then
        goto GoOut
        End If
       
        For y = x + 1 To 30
                            
                If tmp = Range("A" & y).Text Then
                        If cntr Mod 10 = 0 Then
                        cntr = cntr + 1
                        End If
                    Range("A" & y) = Range("A" & y) & "." & cntr
                    cntr = cntr + 1
                End If
        Next
    Next
 
GoOut:
 
End Sub

Quote:

---

Originally Posted by vikasbhandari2

Check if you want this :

VB Code:

Public Sub MarkDups()
    Dim tmp As String
    Dim cntr As Integer
    
    For x = 1 To 30 'rows in my test
        tmp = Range("A" & x).Text
        cntr = 1
                    
        If tmp = "" Then
        goto GoOut
        End If
       
        For y = x + 1 To 30
                            
                If tmp = Range("A" & y).Text Then
                        If cntr Mod 10 = 0 Then
                        cntr = cntr + 1
                        End If
                    Range("A" & y) = Range("A" & y) & "." & cntr
                    cntr = cntr + 1
                End If
        Next
    Next
 
GoOut:
 
End Sub

---

Compile error sub or function not defined. It doesn't like the GoOut

Hmmmm....well Its working fine for me....please make sure that you are using the following code correctly :

VB Code:

If tmp = "" Then
        GoTo GoOut
        End If

Thank you for clearing that up.
Now here’s the next issue. That works perfectly if the column starts w/o any spaces. But mine has 3-4 blank cells in the column along with a header which is a total of about 5 cells from the beginning of the column to when the data I'm interested in marking starts.


example:

blank cell
blank cell
Record Number
Blank cell
blank cell
5110
3506
3985
4949

if your numbers are starting from the 6th row, then you can use the following code

VB Code:

For x = 6 To 30 'rows in my test

Hope it works :)