View Full Version : [SOLVED:] VBA Code to Run Code Across Multiple Worksheets at One Time
Steve Belsch
12-06-2019, 11:22 AM
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
12-06-2019, 02:43 PM
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
12-09-2019, 09:21 AM
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
12-09-2019, 09:25 AM
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
12-09-2019, 09:44 AM
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
12-09-2019, 10:01 AM
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
12-09-2019, 10:17 AM
Here is the file.
Steve Belsch
12-09-2019, 01:50 PM
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
12-09-2019, 02:20 PM
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
12-10-2019, 09:20 AM
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
12-11-2019, 07:14 AM
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
12-11-2019, 02:08 PM
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
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.