VBA - Renaming identical headers

[steinrk]

I have a spreadsheet with more than 600 columns. Unfortunately several of the headers are identical.

I would like to rename these headers so that they become unique.

Lets say that part of the headers looks like this:

[TABLE="width: 768"]
<tbody>[TR]
[TD="width: 64"]a[/TD]
[TD="width: 64"]b[/TD]
[TD="width: 64"]c[/TD]
[TD="width: 64"]d[/TD]
[TD="width: 64"]d[/TD]
[TD="width: 64"]d[/TD]
[TD="width: 64"]d[/TD]
[TD="width: 64"]e[/TD]
[TD="width: 64"]f[/TD]
[TD="width: 64"]f[/TD]
[TD="width: 64"]f[/TD]
[TD="width: 64"]f
[/TD]
[/TR]
</tbody>[/TABLE]

I would have liked to rename this so that they read:

[TABLE="width: 768"]
<tbody>[TR]
[TD="width: 64"]a[/TD]
[TD="width: 64"]b[/TD]
[TD="width: 64"]c[/TD]
[TD="width: 64"]d-1[/TD]
[TD="width: 64"]d-2[/TD]
[TD="width: 64"]d-3[/TD]
[TD="width: 64"]d-4[/TD]
[TD="width: 64"]e[/TD]
[TD="width: 64"]f-1[/TD]
[TD="width: 64"]f-2[/TD]
[TD="width: 64"]f-3[/TD]
[TD="width: 64"]f-4[/TD]
[/TR]
</tbody>[/TABLE]

How can I do this with a macro?

 

[My Aswer Is This]

I'm not sure I see the trend here.

If you want each one Unique

Why not something like

A-1 A-2 A-3 A-4 A-5 A-6

This can be done with Vba.

 

[My Aswer Is This]

Since I do not see the trend I have this suggestion:
Modify to your needs.

Run this script on the active sheet:

Sub Modify_Headers()
'Modified 6/21/2019 2:43:38 AM  EDT
Application.ScreenUpdating = False
Dim i As Long
Dim LastColumn As Long
LastColumn = Cells(1, Columns.Count).End(xlToLeft).Column
For i = 1 To LastColumn
    Cells(1, i).Value = "MrExcel-" & i
Next
Application.ScreenUpdating = True
End Sub

 

[steinrk]

The headers a b c d d d d e f f f f etc. was only given as example. In reality the headers contains much more text. For example one of the headers I want to rename is "SPA B Peak Output Power - milliWatts (spa2B)". This should be renamed to "SPA B Peak Output Power - milliWatts (spa2B) - 1".

So you see I need to keep the original text in the headers and I just need to add a number so that it becomes a unique header.

Hope this makes a bit more sense

 

[Fazza]

maybe

Sub OneWay()
    Dim i As Long
    Dim arIn As Variant
    Dim arOut As Variant

    arIn = Range("A1").CurrentRegion.Resize(1)
    arOut = arIn
    For i = LBound(arIn, 2) To UBound(arIn, 2)
        arOut(1, i) = arIn(1, i)
        If Kount(ThisOne:=arIn(1, i), UpToThisColumn:=UBound(arIn, 2), AllData:=arIn) > 1 Then arOut(1, i) = arOut(1, i) & "-" & Kount(ThisOne:=arIn(1, i), UpToThisColumn:=i, AllData:=arIn)
    Next i
    Range("A1").CurrentRegion.Resize(1).Value2 = arOut
End Sub

Function Kount(ByVal ThisOne As Variant, ByVal UpToThisColumn As Long, ByRef AllData As Variant) As Long
    Dim i As Long
    For i = LBound(AllData, 2) To UpToThisColumn
        If AllData(1, i) = ThisOne Then Kount = Kount + 1
    Next i
End Function

 

[My Aswer Is This]

So this script will add a number to the end of the Header Name starting with 1 then 2 etc.
Will this work?

So if header is Alpha then header will now be Alpha-1
And so on.

Sub Modify_Headers()
'Modified  6/21/2019  3:04:08 AM  EDT
Application.ScreenUpdating = False
Dim i As Long
Dim LastColumn As Long
LastColumn = Cells(1, Columns.Count).End(xlToLeft).Column
For i = 1 To LastColumn
    Cells(1, i).Value = Cells(1, i).Value & "-" & i
Next
Application.ScreenUpdating = True
End Sub

 

[steinrk]

Thank you Fazza. Your code did exactly what I was looking for

What a fantastic Forum this is!!!