VBA: Delete Columns if Duplicate Header

[SteveOranjin]

Hello,

I can't manage to get a macro working. I'd like to create a macro that removes all columns that have duplicate headers.

Please advise,

Steve

 

[Fluff]

If you have 2 columns with a header "Fluff" do you want to delete both columns, or just 1?
If just 1 does it matter which?

 

[wideboydixon]

If the column headers are in row 1, this will remove duplicate columns:

Public Sub RemoveDuplicateColumns()

Dim lastCol As Long
Dim thisCol As Long

lastCol = Cells(1, Columns.Count).End(xlToLeft).Column
thisCol = 2
Do While thisCol <= lastCol
    If Application.Match(Cells(1, thisCol).Value, Range("1:1"), 0) < thisCol Then
        Cells(1, thisCol).EntireColumn.Delete xlShiftToLeft
        lastCol = lastCol - 1
    Else
        thisCol = thisCol + 1
    End If
Loop

End Sub

WBD

 

[SteveOranjin]

Why doesn't this work?

Sub Remove_Duplicate_Columns()


Dim lastCol As Long
Dim thisCol As Long


    With Sheets("Data Sheet")
        lastCol = Cells(1, Columns.Count).End(xlToLeft).Column
        thisCol = 2
        Do While thisCol <= lastCol
            If Application.Match(Cells(1, thisCol).Value, Range("1:1"), 0) < thisCol Then
                Cells(1, thisCol).EntireColumn.Delete xlShiftToLeft
                lastCol = lastCol - 1
            Else
                thisCol = thisCol + 1
            End If
    
    Loop
End With
End Sub

 

[Fluff]

Why doesn't this work?

Very difficult to tell without some more info

 

[SteveOranjin]

Very difficult to tell without some more info

It doesn't like that last end statement (is that a loop?)

I changed his code so it had a line that restricted its operation to the page "data sheet"

 

[Fluff]

Try

Sub Remove_Duplicate_Columns()


Dim lastCol As Long
Dim thisCol As Long

   
   With Sheets("MA (2)")
   lastCol = .Cells(1, Columns.Count).End(xlToLeft).Column
   thisCol = 2
      Do While thisCol <= lastCol
         If Application.Match(.Cells(1, thisCol).Value, .Range("1:1"), 0) < thisCol Then
            .Cells(1, thisCol).EntireColumn.Delete xlShiftToLeft
            lastCol = lastCol - 1
         Else
            thisCol = thisCol + 1
         End If
      Loop
   End With
End Sub

 

[Marcelo Branco]

Or

Sub Remove_Duplicate_Columns()
    Dim lastCol As Long
    Dim thisCol As Long

    With Sheets("Data Sheet")
        lastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
        
        For thisCol = lastCol To 2 Step -1
            If Application.Match(.Cells(1, thisCol).Value, Range(.Cells(1, 1), .Cells(1, lastCol)), 0) <> thisCol Then
                .Cells(1, thisCol).EntireColumn.Delete xlShiftToLeft
            End If
        Next thisCol
    End With
End Sub

M.

 

[Sherli]

If you have 2 columns with a header "Fluff" do you want to delete both columns, or just 1?
If just 1 does it matter which?

Hi, may I know how to remove both columns or 3 columns with same header name?

 

[Fluff]

Please start a thread of your own for this question. Thanks