VBA code to search a specific row (header) for duplicates and modify repeated words??

[dougmarkham]

Hi Folks,

I am processing data in a large table that contains some duplicate column header names e.g., there are 2 headers called "Country", two instances of "Customer" and "Product" etc, etc. I cannot find any instance of this on Google search.

Would you please help with the VBA code?

What it needs to do is search 'row 1' for duplicate header names and rename the second, third, fourth etc occurrences by adding a number representing the occurrence number.

E.g., if Country occurred 3 times in A1, Z1, and AZ1, the VBA would locate the duplicate names and rename the repeats thus...

A1 = Country
Z1 = Country1
AZ1 = Country2

Kind regards,

Doug.

 

[wideboydixon]

Public Sub RenameHeaders()

Dim lastCol As Long
Dim thisCol As Long
Dim testCol As Long
Dim foundCount As Long

lastCol = Cells(1, Columns.Count).End(xlToLeft).Column
For thisCol = 1 To lastCol - 1
    If Cells(1, thisCol).Value <> "" Then
        foundCount = 0
        For testCol = thisCol + 1 To lastCol
            If Cells(1, thisCol).Value = Cells(1, testCol).Value Then
                foundCount = foundCount + 1
                Cells(1, testCol).Value = Cells(1, thisCol).Value & CStr(foundCount)
            End If
        Next testCol
    End If
Next thisCol

End Sub

WBD

 

[dougmarkham]

Public Sub RenameHeaders()

Dim lastCol As Long
Dim thisCol As Long
Dim testCol As Long
Dim foundCount As Long

lastCol = Cells(1, Columns.Count).End(xlToLeft).Column
For thisCol = 1 To lastCol - 1
    If Cells(1, thisCol).Value <> "" Then
        foundCount = 0
        For testCol = thisCol + 1 To lastCol
            If Cells(1, thisCol).Value = Cells(1, testCol).Value Then
                foundCount = foundCount + 1
                Cells(1, testCol).Value = Cells(1, thisCol).Value & CStr(foundCount)
            End If
        Next testCol
    End If
Next thisCol

End Sub

WBD

Hi WBD,

This did the trick, thank you very much!

Kind regards,

Doug.