Delete multiple columns in multiple sheets across multiple workbooks

I have to update 100s of Excel workbooks. Each workbook has multiple worksheets (no fixed number but maximum 50).

The idea is, with VBA code (Excel 2010), to go through all worksheets and delete entire columns based on criteria.

Every worksheet has a header column that starts with:

Date ; 2024-09-20 ; 2023-02-06 ; 2020-01-01 ; 2019-02-09 ; 1999-09-09 and so on.

The dates are variable.

I want to delete all columns that are 2019 or earlier.

This is what I came up with using answers in other posts.
It doesn't process all columns in all sheets. I have to run several times.
Further the columns are not deleted. The data from the column is cleared but the blank column still exists.

Dim a As Long, w As Long, match1 As String
With ThisWorkbook
    For w = 1 To .Worksheets.Count
        With Worksheets(w)
            
        For i = 50 To 1 Step -1
            match1 = CStr(Cells(1, i))
            If match1 Like "201?-*" Then
                Columns(i).EntireColumn.Delete
            End If
            If match1 Like "200?-*" Then
                Columns(i).EntireColumn.Delete
            End If
            If match1 Like "199?-*" Then
                Columns(i).EntireColumn.Delete
            End If
            If match1 Like "198?-*" Then
                Columns(i).EntireColumn.Delete
            End If            
        Next i
        End With
    Next w
End With

Solution

This was not thoroughly tested apart from a hastily made folder with three spreadsheets, so I would suggest to proceed with caution and test it first on some dummy data just in case:

Sub DeleteOldDateColumnsInDirectory()
    Dim folderPath As String
    Dim fileName As String
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim col As Integer
    Dim headerDate As Date
    
    ' Specify the folder path (update this to your directory)
    folderPath = "C:\folderpath\etc\"
    
    ' Disable screen updating and automatic calculations for better performance
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    ' Get the first .xlsx file in the folder
    fileName = Dir(folderPath & "*.xlsx")
    
    ' Loop through each file in the folder
    Do While fileName <> ""
        ' Open the workbook
        Set wb = Workbooks.Open(folderPath & fileName)
        
        ' Loop through each worksheet in the workbook
        For Each ws In wb.Worksheets
            ' Start from the last column and work backwards
            For col = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column To 1 Step -1
                On Error Resume Next
                ' Try to interpret the header as a date
                headerDate = CDate(ws.Cells(1, col).Value)
                On Error GoTo 0
                
                ' If it’s a date and 2019 or earlier, delete the column
                If IsDate(headerDate) And Year(headerDate) <= 2019 Then
                    ws.Columns(col).Delete
                End If
            Next col
        Next ws
        
        ' Save and close the workbook
        wb.Close SaveChanges:=True
        
        ' Move to the next file
        fileName = Dir
    Loop
    
    ' Re-enable screen updating and calculations
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    
    MsgBox "Columns deleted in all workbooks in the folder."
End Sub