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