Loop through range and append values based on count

Question

Search the web and SO, but couldn't find an answer that helped me. Hoping a direct question can lead to community enlightenment.

I want to create code that looks through a range (column headers), detects duplicates, and then appends each duplicate with the count.

For example, my column headers look like this:

• Vendor
• Tracking Number
• Display In
• Type
• Call Report Flag
• Type
• Due
• Created By
• Created
• Created By
• Created

After running the code, I would like them to look like this:

• Vendor
• Tracking Number
• Display In
• Type1
• Call Report Flag
• Type2
• Due
• Created By1
• Created1
• Created By2
• Created2

Non-duplicates were left alone, duplicates have been appended by the current count.

I've attempted some code and it counts the # of duplicates using 'for each cell in my range' but once it appends the count, it then no-longer sees it as a duplicate, so when it moves to the next cell it won't append.

Here's my code (although I think I may need to start with a different strategy):

Sub TestSub()

Dim Counter As Integer
Dim Cell As Range
Dim Headers As Range

Set Headers = Worksheets("TEST SHEET").UsedRange.Rows("1:1")
Counter = 1

For Each Cell In Headers.Cells.Value
    If WorksheetFunction.CountIf(Headers, Cell.Value) > 1 Then
        Cell.Value = Cell.Value & Counter
    End If
    Counter = Counter + 1
Next Cell

End Sub

Hoping someone can help.

Answer 1

This uses the basics of this formula:

=IF(COUNTIF(1:1,A1)>1,A1&COUNTIF($A$1:A$1,A1),A1)

To do what you want:

Sub TestSub()

Dim Cell As Range
Dim Headers As Range
Dim Headers2 As Range
With Worksheets("TEST SHEET")
    Set Headers = .UsedRange.Rows("1:1")
    Headers.Copy .Range("A" & Worksheets("Sheet3").Rows.Count)
    Set Headers2 = .UsedRange.Rows(.Rows.Count & ":" & .Rows.Count)

    For Each Cell In Headers.Cells
        If WorksheetFunction.CountIf(Headers2, Cell.Value) > 1 Then
            Cell.Value = Cell.Value & WorksheetFunction.CountIf(Range("A" & .Rows.Count, .Cells(.Rows.Count, Cell.Column)), Cell.Value)
        End If
    Next Cell
    Headers2.ClearContents

End With
End Sub

We need to copy the headers to another location to use as in the COUNTIF(). Otherwise once the first gets changed none of the other will be equal and the countif fails to find more than one.