Help finding and tracking unique duplicate values, append # to name

**deqx** · 09-21-2012, 09:06 AM

I have a dynamic 1D range (up to 15 rows) to search for unique duplicate values. All appear in Column B. Instead of removing duplicate values, I want to append a number to the end of the value like Windows does for file names.

Name, Another Name, Some Name, Name (2), YourMomsName, Some Name (2), Al Bundy, Name (3)

I have a macro to find the range of the names, and I've been fiddling with macros to find duplicate values. What I need help with is tracking the unique ones, ignoring the first instances, then updating the name with the correct number added to it.

**wallyeye** · 09-21-2012, 12:45 PM

Something like:

Public Sub AppendSeq(ByVal Target As Excel.Range)

    Dim scpValues           As Object

    Dim arrValues           As Variant
    Dim arrOutput           As Variant

    Dim lngRow              As Long
    Dim intOccur            As Integer
    Dim strOccur            As String

    Set scpValues = CreateObject("Scripting.Dictionary")
    scpValues.CompareMode = TextCompare

    arrValues = Target.Resize(Target.Rows.Count, 1).Value
    ReDim arrOutput(LBound(arrValues, 1) To UBound(arrValues, 1), 1 To 1)
    For lngRow = LBound(arrValues, 1) To UBound(arrValues, 1)
        strOccur = ""
        If scpValues.Exists(arrValues(lngRow, 1)) Then
            intOccur = 1
            While scpValues.Exists(arrValues(lngRow, 1) & " (" & intOccur & ")")
                intOccur = intOccur + 1
            Wend
            scpValues(arrValues(lngRow, 1) & " (" & intOccur & ")") = lngRow
            strOccur = " (" & intOccur & ")"
        Else
            scpValues(arrValues(lngRow, 1)) = lngRow
        End If
        arrOutput(lngRow,1) = arrValues(lngRow, 1) & strOccur
    Next lngRow

    Target.Value = arrOutput

    Set scpValues = Nothing

End Sub

Just pass the range to it. The routine loads the given range values into an array, then loops through the array. The Scripting.Dictionary object is an easy way to check for duplicates, here it first checks if a value has already been added, if so, it increments a counter until it finds one that hasn't. It puts the adjusted value into an output array, then at the end places the output array back into the target values.

**deqx** · 09-23-2012, 01:14 AM

You rock. It's working nicely. I changed it ever-so slightly so duplicates would begin at "(2)." Thank you!

...
scpValues(aryValues(lngRow, 1) & " (" & intOccur & ")") = lngRow
strOccur = " (" & intOccur + 1 & ")"
...

**wallyeye** · 09-24-2012, 10:55 AM

Glad to be of help.

**deqx** · 10-01-2012, 09:24 PM

New scope for this function. What I have the worksheet doing is allowing users to enter names and create sheets based on those names. The rows containing the names they enter on the main worksheet get locked. However, the user can still go back to the main sheet and add rows with names under the locked cells and create sheets again (bypassing locked cells of names already created). So the goal now for this duplicates function is to be able to catch previously appended names. If there's already a Name (2), and the user enters another row with Name, this function changes it to Name (2) and Excel shoots a sheet name error. I'd like it to know that Name (2), Name (3), Name (4), etc. are still duplicates of Name.

One possible solution might be to go through the new list of names and remove any appended text before checking for duplicates, then re-insert the array of values. However, the user may enter names with parenthetical text and numbers, so it could be tricky.