Adding a unique name to duplicate values in a column

[dominikapabis]

Hello,

I need help writing a VBA macro that will search for duplicates in a column and add a unique identifier. So that I can mark some, not all for deletion further on in my macro ( I already have that part written out)

For Example:

[TABLE="width: 300"]
<tbody>[TR]
[TD][/TD]
[TD]A[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]AAA
[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]BBB[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]AAA[/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD]BBB[/TD]
[/TR]
</tbody>[/TABLE]




[TABLE="width: 300"]
<tbody>[TR]
[TD][/TD]
[TD]A[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]AAA
[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]BBB[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]AAA #1[/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD]BBB #2[/TD]
[/TR]
</tbody>[/TABLE]



Here's the catch...

After the rest of my code runs, I need to remove the remaining unique identifiers in the column also in a macro.

I would greatly appreciate any help!

Thanks!

 

[LockeGarmin]

I probably don't understand your question right, but why don't you just insert a column at column 'A', fill it in with incrementing numbers (1, 2, 3 etc.), do stuff, and then delete Column A to delete the unique identifiers?

 

[Peter_SSs]

I'm not sure about the second part of your question, but try this (in a copy of your workbook) for appending the identifiers to the duplicate values.

Sub AppendNums()
  Dim a As Variant
  Dim d As Object
  Dim i As Long, k As Long
  
  Set d = CreateObject("Scripting.Dictionary")
  a = Range("A1", Range("A" & Rows.Count).End(xlUp)).Value
  For i = 1 To UBound(a)
    If Len(a(i, 1)) Then
      If d.exists(a(i, 1)) Then
        k = k + 1
        a(i, 1) = a(i, 1) & " #" & k
      Else
        d(a(i, 1)) = 1
      End If
    End If
  Next i
  Range("A1").Resize(UBound(a)).Value = a
End Sub

 

[Peter_SSs]

I'm not sure about the second part of your question, ..

On re-reading, perhaps it is just this

Sub RemoveIdentifiers()
  Range("A1", Range("A" & Rows.Count).End(xlUp)).Replace What:=" #*", Replacement:="", LookAt:=xlPart, SearchFormat:=False, ReplaceFormat:=False
End Sub