Delete columns if they have same header

[chouba]

Hello,
I m working on VBA code to delete columns if they have same headers. I have found some solution but most of them takes too much time as they read cells 1 by 1.
Here are some information :
- My headers are in row 1
- I need an efficient vba code that can handle 10 000+ columns in fastest way( maybe work with a variable that contains the range and than paste it back on the sheet)
- I want to keep the first instance of each column ( for example if we have headers like = " pizza - pizza - burger" I want to keep "pizza - burger" columns)
- I cannot provide an exemple but if more informations are needed I can answer you

Thanks a lot for your help

 

[Sufiyan97]

try

Sub chouba()
Dim wsh As Worksheet
Dim A As Range

For Each wsh In ActiveWorkbook.Worksheets
    Do
        Set A = Rows(1).Find(What:="Pizza", LookIn:=xlValues, lookat:=xlPart)
        If A Is Nothing Then Exit Do
        A.EntireColumn.Delete
    Loop
Next wsh

End Sub

 

[chouba]

Thank you for your reply !

Unfortunately I dont want to remove columns with a specific name but all the columns that are duplicated based on header name.

 

[Fluff]

How about

Sub chouba()
   Dim Cl As Range, Rng As Range
   
   With CreateObject("scripting.dictionary")
      For Each Cl In Range("A1", Cells(1, Columns.Count).End(xlToLeft))
         If Not .exists(Cl.Value) Then
            .Add Cl.Value, Nothing
         Else
            If Rng Is Nothing Then Set Rng = Cl Else Set Rng = Union(Rng, Cl)
         End If
      Next Cl
   End With
   If Not Rng Is Nothing Then Rng.EntireColumn.Delete
End Sub

 

[chouba]

Ok it works perfect thanks alot! I tried with 10k columns and woks great !

Last question about my code structure :

For my data I need first to get the headers from a Vlookup (in another sheet). In order to get this faster i do it in a variant like this then I use your code
Do you think there is an more effcient way to do it ?

'Store the data in a range
data = Range("A1", Cells(lastRow, lastCol)).Value

'Vlookup to get headers
For i = 2 To lastCol - 1
    data(1, i) = Application.WorksheetFunction.VLookup(ActiveSheet.Cells(RowIndex:=1, ColumnIndex:=i + 1), Range("Dataa"), 21, 0)
Next i

'Put back on the sheet
Range("A1", Cells(lastRow, lastCol)).Value = data

'Here i put your piece of code

'Here I do same steps that before but for rows ( with Cells.RemoveDuplicates Columns:=Array(1) which is quite fast)

Thanks again for your time I m still discovering VBA coding

 

[Fluff]

Do you think there is an more effcient way to do it ?

Yes, just use the code I supplied.

 

[chouba]

perfect thx

 

[Fluff]

Glad we could help & thanks for the feedback.