Excel VBA - Find matching column headings and delete the column - vba

Question

Apologies if this has been answered before, I'm unable to find anything that matches my specific case.
I have a workbook with 18 sheets, and a variable number of columns per sheet starting at B2. Occasionally the program that generates the sheet will create duplicate columns, due to this, I need a macro triggered by button to search each sheet for matching column headers and then delete one of these columns (the whole column, not just the header).
So far I'm pretty stuck, I've been able to delete all matches from any cell in the sheet, which pretty much wipes the entire sheet out. I just need to match headers and then delete the entire column based on that.
Let me know if you need any more information, and thank you for the help!
What I have so far, the code is doing some other stuff too so this needs to continue working.
Sub RemoveExtras()
Dim MyRange As Range
Dim ws As Worksheet
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
BadCharacters = Array(Chr(10), Chr(13))
wsNumber = Sheets.Count
For Each ws In Worksheets
With ws
For Each MyRange In .UsedRange
If 0 < InStr(MyRange, Chr(10)) Then
For Each i In BadCharacters
MyRange = Replace(MyRange, i, vbNullString)
Next i
End If
For t = 1 To wsNumber
Columns(t).RemoveDuplicates Columns:=Array(1), Header:=xlYes
Next t
Next MyRange
End With
Next ws
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

Answer 1

Dictionaries are perfect for handling unique values:
Sub RemoveExtras()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim c As Integer, i As Integer, ws As Worksheet
Dim dict As Object
For Each ws In Worksheets
Set dict = CreateObject("Scripting.Dictionary")
'Find Last column
c = ws.UsedRange.Columns.Count
'Loop backwards
For i = c To 2 Step -1
'If column does not exist in dictionary, then add it
If Not dict.Exists(ws.Cells(2, i).Value) Then
dict.Add ws.Cells(2, i).Value, 1
Else
'Otherwise delete column
ws.Columns(i).Delete Shift:=xlToLeft
End If
Next i
Set dict = Nothing
Next
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Here you do not compare every pair of column headers in the sheet. Also this compares headers across all the worksheets, not just duplicates inside one individual sheet.

Answer 2

See if this helps you
Sub test()
Dim book As Workbook, sheet As Worksheet, text As String
For Each sheet In Worksheets
Set MR = Range("B2:Z2") 'change Z2 as per your requirement
For Each cell In MR
Set BR = Range("B2:Z2") 'change Z2 as per your requirement
For Each cell2 In BR
If cell.Value = cell2.Value Then cell.EntireColumn.Delete
Next
Next
Next sheet
End Sub