VBA to delete all columns except "" for all workbooks in a folder

[thedeadzeds]

Hi All,

I've found the following code which works great. Is there a way to get this code to open all workbooks in a folder and run this for all worksheets called 'export' .

Thanks

Sub DeleteSelectedColumns()
Dim currentColumn As Integer
Dim columnHeading As String

For currentColumn = ActiveSheet.UsedRange.Columns.Count To 1 Step -1
    columnHeading = ActiveSheet.UsedRange.Cells(1, currentColumn).Value

'Check whether to preserve the column
    Select Case columnHeading
    'Insert name of columns to preserve
        Case "Date", "Name", "Amount Owing", "Balance"
            'Do nothing
        Case Else
            'Delete the column
            ActiveSheet.Columns(currentColumn).Delete
        End Select
    Next
End Sub

 

[frabulator]

You could loop through a folder, open only the Excel documents and then run the code if one of the names of the sheets are 'export'.

Sub LoopThroughFiles()

    Application.ScreenUpdating = False 'comment this out if you would like to see what is going on

    Dim wbk As Workbook
    Dim MyFile As String
    Dim ws As Worksheet
   
    Dim MyFolder As String
    MyFolder = ("C:\testFolder\")
    MyFile = Dir(MyFolder) 'DIR gets the first file of the folder
    'Loop through all files in a folder until DIR cannot find anymore
    Do While MyFile <> ""
       
        If InStr(CStr(MyFile), ".xls") Or InStr(CStr(MyFile), ".xlsx") Or InStr(CStr(MyFile), ".xlsm") Or InStr(CStr(MyFile), ".xlm") Then
            'Opens the file and assigns to the wbk variable for future use
            Set wbk = Workbooks.Open(Filename:=MyFolder & MyFile)
            'Checks to see the sheet name and then runs the code if it matches
            For Each ws In wbk.Worksheets
                If ws.Name = "export" Then DeleteSelectedColumns
            Next
            wbk.Close
           
        End If
       
       
        MyFile = Dir 'DIR gets the next file in the folder
    Loop
   
    Application.ScreenUpdating = True
 
    MsgBox ("Completed")
    
End Sub