VBA Code to Run Code Across Multiple Worksheets at One Time

[Steve Belsch]

VBA Experts,

I have build this code as an attempt to run a macro across all the worksheets (57 of them) at the same time so that I don't have to go into each worksheet and run it one at a time. Here is what I wrote. It is not giving me an error message but it is not running the my code in any of the worksheets. I think the problem is with my ElseIf? of the 57 tabs I have 8 tabs that I do not want to run this code on. So I listed them in the ElseIf. Any ideas what I am doing wrong?

Thanks!
Steve


Sub RunMacroAcrossAllTabs()
Dim xSh As Worksheet
Application.ScreenUpdating = False
For Each xSh In Worksheets

If xSh.Name <> "Instructions" Then
xSh.Activate

ElseIf xSh.Name <> "Accrual & PO Data" Then
xSh.Activate

ElseIf xSh.Name <> "Tab Name List" Then
xSh.Activate

ElseIf xSh.Name <> "Macro Buttons" Then
xSh.Activate

ElseIf xSh.Name <> "Summary FY Fcst3 & FY20 Budge" Then
xSh.Activate

ElseIf xSh.Name <> "EP Local" Then
xSh.Activate

ElseIf xSh.Name <> "Driver Definitions" Then
xSh.Activate

ElseIf xSh.Name <> "EP Global" Then
xSh.Activate



Else
xSh.Select
Call RunCode
End If


Next xSh
Application.ScreenUpdating = True
End Sub

[Paul_Hossler]

Not 100% sure of your logic or what RunCode is defined as, but I'd pass the worksheet to RunCode




Option Explicit




Sub RunMacroAcrossAllTabs()
Dim xSh As Worksheet

Application.ScreenUpdating = False

For Each xSh In ThisWorkbook.Worksheets

Select Case xSh.Name
Case "Instructions", "Accrual & PO Data", "Tab Name List", "Macro Buttons", "Summary FY Fcst3 & FY20 Budge", "EP Local", "Driver Definitions", "EP Global"
'skip

Case Else
Call RunCode(xSh)
End Select
Next xSh

Application.ScreenUpdating = True
End Sub






Sub RunCode(ws As Worksheet)


MsgBox ws.Name




End Sub

[Steve Belsch]

Thanks Paul.

I get this error message when I try the code you suggested. Any idea why?

Run-Time error '1004':
Sort method of range class failed

[Steve Belsch]

Here is the code that you suggested and then I have included the Run Code ()



Sub RunMacroAcrossAllTabs()
Dim xSh As Worksheet
Application.ScreenUpdating = False
For Each xSh In Worksheets

Select Case xSh.Name
Case "Instructions", "Accrual & PO Data", "Tab Name List", "Macro Buttons", "Summary FY Fcst3 & FY20 Budge", "EP Local", "Driver Definitions", "EP Global"
'skip

Case Else
Call RunCode
End Select


Next xSh
Application.ScreenUpdating = True
End Sub
Sub RunCode()
'Subtotal Code


Dim iCol As Integer
Dim i As Integer
Dim J As Integer


Application.ScreenUpdating = False


'Copy & Paste values
Range("A1:N236").Copy
Range("A1:N236").PasteSpecial xlPasteValues


Range("K1:K236").Copy
Range("K1:K236").PasteSpecial xlPasteValues


Range("S1:T236").Copy
Range("S1:T236").PasteSpecial xlPasteValues




'Diable marching ants around copied range
Application.CutCopyMode = True




i = 3
J = i
'Sort the data so like data is grouped together.


'Loops throught Col A Checking for match then when there is no match then stop and add Subtotal
Do While Range("A" & i) <> ""
If Range("A" & i) <> Range("A" & (i + 1)) Then
Rows(i + 1).Insert
Range("A" & (i + 1)) = "Subtotal " & Range("A" & i).Value
For iCol = 13 To 73 'Columns to Subtotal
Range(Cells(i + 1, 13), Cells(i + 1, 73)).FormulaR1C1 = "=SUBTOTAL(9,R" & J & "C:R[-1]C)"
Next iCol
Range(Cells(i + 1, 1), Cells(i + 1, 73)).Font.Bold = True
Range(Cells(i + 1, 1), Cells(i + 1, 73)).BorderAround ColorIndex:=1




i = i + 2
J = i
Else
i = i + 1
End If
Loop
Application.ScreenUpdating = True



End Sub

[Paul_Hossler]

Remember, I said


... pass the worksheet to RunCode

This is not tested since I don't have any test data / workbooks




Option Explicit


Sub RunMacroAcrossAllTabs()
Dim xSh As Worksheet
Application.ScreenUpdating = False
For Each xSh In Worksheets

Select Case xSh.Name
Case "Instructions", "Accrual & PO Data", "Tab Name List", "Macro Buttons", "Summary FY Fcst3 & FY20 Budge", "EP Local", "Driver Definitions", "EP Global"
'skip

Case Else
Call RunCode(xSh) ' <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
End Select


Next xSh
Application.ScreenUpdating = True
End Sub




Sub RunCode(ws As Worksheet) ' <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
'Subtotal Code


Dim iCol As Integer
Dim i As Integer
Dim J As Integer


Application.ScreenUpdating = False

With ws ' <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
'Copy & Paste values
.Range("A1:N236").Copy ' <<<<<<<<<<<<<<<<<<<<<<< note the dot
.Range("A1:N236").PasteSpecial xlPasteValues


.Range("K1:K236").Copy
.Range("K1:K236").PasteSpecial xlPasteValues


.Range("S1:T236").Copy
.Range("S1:T236").PasteSpecial xlPasteValues


'Diable marching ants around copied range
Application.CutCopyMode = True




i = 3
J = i

'Sort the data so like data is grouped together.

'Loops throught Col A Checking for match then when there is no match then stop and add Subtotal
Do While .Range("A" & i) <> ""
If .Range("A" & i) <> .Range("A" & (i + 1)) Then
.Rows(i + 1).Insert
.Range("A" & (i + 1)) = "Subtotal " & .Range("A" & i).Value

For iCol = 13 To 73 'Columns to Subtotal
.Range(Cells(i + 1, 13), Cells(i + 1, 73)).FormulaR1C1 = "=SUBTOTAL(9,R" & J & "C:R[-1]C)"
Next iCol

.Range(Cells(i + 1, 1), Cells(i + 1, 73)).Font.Bold = True
.Range(Cells(i + 1, 1), Cells(i + 1, 73)).BorderAround ColorIndex:=1

i = i + 2
J = i
Else
i = i + 1
End If
Loop

End With


Application.ScreenUpdating = True

End Sub

[Steve Belsch]

Paul,

Thanks. I will send the file. I put in this code in and got this error message Compile error: Wrong number of arguments or invalid property assignment.

I am not sure what you mean by "Pass the worksheet to run code"? Does this mean skip the 8 tabs that are in parenthesis?

Steve

[Steve Belsch]

Here is the file.

[Steve Belsch]

Paul,

I tried running this code. And my goal is to not RunCode on the tab names in "", 8 of them. But it goes directly to the first of these 8 tab and performs the RunCode, and then it moves to the next sheet and does the same things, and so on. Do I have my code backwards? Why is the For If Else Next not working in terms of moving past the 8 tabs and then RunCode on the rest of the tabs? Thanks for any ideas!

Sub RunMacroAcrossAllTabs()
Dim xSh As Worksheet
Application.ScreenUpdating = False
For Each xSh In Worksheets

If xSh.Name > "Instructions" And xSh.Name > "Accrual & PO Data" And xSh.Name > "Tab Name List" And xSh.Name <> "Macro Buttons" And xSh.Name <> "Summary FY19 Fcst3 & FY20 Budge" And xSh.Name <> "EP Local" And xSh.Name <> "Driver Definitions" And xSh.Name <> "EP Global" Then
xSh.Activate



Else
xSh.Select
Call RunCode
End If


Next xSh
Application.ScreenUpdating = True
End Sub



Thanks.
Steve

[Paul_Hossler]

You didn't copy all of the macros I gave you

There's several other issues with your macro, so I added an Exit Sub after verified that only the desired sheets were going to be used

I also set Calculate to Manual since it was taking too long



Option Explicit


Sub RunMacroAcrossAllTabs()
Dim xSh As Worksheet
Application.ScreenUpdating = False
For Each xSh In Worksheets

Select Case xSh.Name
Case "Instructions", "Accrual & PO Data", "Tab Name List", "Macro Buttons", "Summary FY Fcst3 & FY20 Budge", "EP Local", "Driver Definitions", "EP Global"
'skip

Case Else
Call RunCode(xSh)
End Select



Next xSh
Application.ScreenUpdating = True
End Sub






Sub RunCode(ws As Worksheet)
'Subtotal Code


Dim iCol As Integer
Dim i As Integer
Dim J As Integer


Application.ScreenUpdating = False


With ws

MsgBox .Name ' Debugging
Exit Sub

'Copy & Paste values
.Range("A1:N236").Copy
.Range("A1:N236").PasteSpecial xlPasteValues

.Range("K1:K236").Copy
.Range("K1:K236").PasteSpecial xlPasteValues

.Range("S1:T236").Copy
.Range("S1:T236").PasteSpecial xlPasteValues


'Diable marching ants around copied range
Application.CutCopyMode = True


i = 3
J = i
'Sort the data so like data is grouped together.
.Range("A5").CurrentRegion.Offset(1).Sort .Range("A12"), 1

'Loops throught Col A Checking for match then when there is no match then stop and add Subtotal
Do While .Range("A" & i) <> ""
If .Range("A" & i) <> .Range("A" & (i + 1)) Then
.Rows(i + 1).Insert
.Range("A" & (i + 1)) = "Subtotal " & .Range("A" & i).Value

For iCol = 13 To 73 'Columns to Subtotal
.Range(Cells(i + 1, 13), Cells(i + 1, 73)).FormulaR1C1 = "=SUBTOTAL(9,R" & J & "C:R[-1]C)"
Next iCol

.Range(Cells(i + 1, 1), Cells(i + 1, 73)).Font.Bold = True
.Range(Cells(i + 1, 1), Cells(i + 1, 73)).BorderAround ColorIndex:=1

i = i + 2
J = i
Else
i = i + 1
End If
Loop
End With



Application.ScreenUpdating = True

End Sub

[Steve Belsch]

Paul,

Thank you for all of the help! Any ideas on why this is so slow? Not sure how I could speed things up.

Steve

[Paul_Hossler]

Paul,

Thank you for all of the help! Any ideas on why this is so slow? Not sure how I could speed things up.

Steve


1. No problem

2. You have a LOT of formulas that need to be calculated. One approach might be to use a macro to calculate the formula results based on the inputs.

Little (or a lot) inconvenient but at least there are fewer formulas

[Steve Belsch]

1. No problem

2. You have a LOT of formulas that need to be calculated. One approach might be to use a macro to calculate the formula results based on the inputs.

Little (or a lot) inconvenient but at least there are fewer formulas

Paul,

What would I do to reduce the formulas with a Macro?

thanks,
steve