Rename duplicate column header names

[abenitez77]

I have a spreadsheet that gets created dynamically..and has x number of columns. It has column header names and sometimes these could contain duplicates. I want to rename one by putting a "2" at the end of the column header so that there are no duplicates. How can i do this with vba?

I tried code to help me get close but does not work...It errors out in the If Application... row

'Rename any Duplicate Column names
With Sheets(myCurrentSheet)
For thisCol = lastCol To 2 Step -1
If Application.Match(.Cells(1, thisCol).Value, Range(.Cells(1, 1), .Cells(1, lastCol)), 0) <> thisCol Then
' If Application.Match(.Cells(1, thisCol).Value, .Range("1:1"), 0) < thisCol Then

MsgBox ("Duplicate")
End If
Next thisCol
End With

 

[lrobbo314]

This seems to work. It will work with multiple duplicates, so it will keep count of how many duplicates it has found and add a "2", "3", "4", etc,.

Sub DuplicateColumns()
Dim r As Range:         Set r = Range("A1:H1") 'Change to area where your column headers are.
Dim AR() As Variant:    AR = r.Value
Dim SD As Object:       Set SD = CreateObject("Scripting.Dictionary")


For i = LBound(AR) To UBound(AR, 2)
    If SD.exists(AR(1, i)) Then
        SD(AR(1, i)) = SD(AR(1, i)) + 1
        AR(1, i) = AR(1, i) & SD(AR(1, i))
    Else
        SD(AR(1, i)) = 1
    End If
Next i


r.Value = AR
End Sub

 

[abenitez77]

Thanks, this is very helpfull