Run macros on whole workbook

[amandajean]

Hola,

I am putting together a database. I have two separate macros I need to run and they work great individually. Right now I am running the macros individually on each spreadsheet. I have hundreds of workbooks full of data to go through..trying to speed up the process. Can someone help me edit the code? I think I need to do an array, but I'm too new to figure that out.

Macro 1 (gain) needs to run on the following spreadsheet names: Lat vHIT Gains, LARP vHIT Gains, RALP Gains



Sub deleteIrrelevantColumnsgain()
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 KEEP THE COLUMN
Select Case columnHeading
Case "Gain"
'Do nothing
Case Else
ActiveSheet.Columns(currentColumn).Delete
End Select
Next
End Sub



Macro 2 (eye head) needs to run on the following spreadsheet names: Lat vHIT VOR Traces, LARP vHIT Traces, RALP vHIT Traces



Sub deleteIrrelevantColumnseyehead()
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 KEEP THE COLUMN
Select Case columnHeading
Case "Eye", "Head"
'Do nothing
Case Else
ActiveSheet.Columns(currentColumn).Delete
End Select
Next
End Sub

[jolivanes]

It would be wise to try it on a copy or several copies of your original(s) first.
I have assumed a few things.
I assume that all six sheets are in the one workbook.
In sheets Lat vHIT Gains, LARP vHIT Gains and RALP Gains, delete all columns except the column with a header "Gain"
This header is always in the first row. There is just one header named "Gain".
In sheets Lat vHIT VOR Traces, LARP vHIT Traces and RALP vHIT Traces, delete all columns except the columns with a header "Eye" or "Head"
Headers are always in the first row. There is just one header named "Eye" and one header named "Head"

Sub Maybe()
Dim shArr1, shArr2, sh As Worksheet
shArr1 = Array("Lat vHIT VOR Traces", "LARP vHIT Traces", "RALP vHIT Traces")
shArr2 = Array("Lat vHIT Gains", "LARP vHIT Gains", "RALP Gains")
Application.ScreenUpdating = False
For Each sh In Sheets(shArr1)
With sh
Union(.Rows(1).Find("Eye", , , 1), .Rows(1).Find("Head", , , 1)).EntireColumn.Hidden = True
With .UsedRange
.SpecialCells(12).EntireColumn.Delete
.Columns.Hidden = False
End With
End With
Next sh
For Each sh In Sheets(shArr2)
With sh
.Rows(1).Find("Gain", , , 1).EntireColumn.Hidden = True
With .UsedRange
.SpecialCells(12).EntireColumn.Delete
.Columns.Hidden = False
End With
End With
Next sh
Application.ScreenUpdating = True
End Sub

It is pretty simple to change this code to work for all workbooks in a folder.
Spelling of sheet names and headers need to be all the same. No leading or trailing spaces although code can take care of that if required.

[Paul_Hossler]

Assuming that

1. this wb is in the same folder as the others
2. it's the xlsx ones
3. since this in not tested, you can fix as needed

It loops all workbooks in the folder, and then all worksheets in each workbook
Checks the WS name and deletes the columns
I made the checks all in lower case after a trim

Not tested and could be made more effecient




Option Explicit


Sub DoAll()
Dim sWB1 As String, sWB2 As String
Dim wb1 As Workbook, wb2 As Workbook
Dim ws2 As Worksheet
Dim currentColumn As Long
Dim columnHeading As String


Set wb1 = ThisWorkbook
sWB1 = ThisWorkbook.Name


sWB2 = Dir(wb1.Path & Application.PathSeparator & "*.xlsx")

Do While Len(sWB2) > 0

If sWB2 = ThisWorkbook.FullName Then GoTo NextFile

Workbooks.Open sWB2
Set wb2 = ActiveWorkbook

For Each ws2 In wb2.Worksheets

Application.StatusBar = wb2.Name & " -- " & ws2.Name

Select Case LCase(Trim(ws2.Name))
Case "lat vhit gains", "larp vhit gains", "ralp gains"

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

Select Case columnHeading
Case "gain"
'Do nothing

Case Else
ws2.Columns(currentColumn).Delete
End Select
Next

Case "lat vhit vor traces", "larp vhit traces", "ralp vhit traces"

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


Select Case columnHeading
Case "eye", "head"
'Do nothing
Case Else
ws2.Columns(currentColumn).Delete
End Select
Next
End Select
Next

NextFile:

wb2.Close True
sWB2 = Dir
Loop


Application.StatusBar = False


End Sub