Excel VBA Question: Delete multiple columns in multiple sheets across multiple workbooks that meet certain criteria

I have to update 100’s of excel workbooks; each workbook has multiple worksheets (no fixed number but max. 50);

The idea is to write a VBA code (using 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.

MEDevel.com: Open-source for Healthcare and Education

Collecting and validating open-source software for healthcare, education, enterprise, development, medical imaging, medical records, and digital pathology.

Visit Medevel

I want to delete all columns that are 2019 or earlier. i am a total beginner but this will save me a lot of effort; this is what i came up with using answers in other posts, but somehow its not doing the job. infact, everytime the macro is run, it doesnt delete all columns in all shets; i have to run several times and on each individual sheet. further the columns are not deleted, instead just the data from the column is cleared and the blank column still exists. totally stumped.

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

help, greatly appreciated.

>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