Run VBA on all open tabs

Dannottheman

Board Regular
Joined
Dec 24, 2020
Messages
55
Office Version
  1. 2007
Hi,

I searched but could not find an answer to this. How can I make the 3 VBAs below run on all the open sheets/tabs in my Excel? Right now I have to manually click on each each sheet and "execute", "execute", "execute", etc...
Ideally, I would have 20 open spreadsheets and the VBAs would apply to all of them. Right now I have to click at least 100 to 150 times to make the changes in 20 sheets when in reality it would be great to click just 5 to 10 times total. Thank you in advance as this task is stressing me out and I have hundreds of these sheets.

VBA 1:
class=prism-token>Option Explicit
Sub Dannottheman3()
Dim Cl As Range
Dim srch As Variant
For Each Cl In Range("A1", Range("A" & Rows.Count).End(xlUp))
For Each srch In Array("quiz", "unit", "exam", class=prism-token>"examen", "assessment", "test") ' <= note the different use of the jolly (could be useful)
If " " & LCase(Cl.Value) & " " Like "*[!a-z0-9]" & srch & "[!a-z0-9]*" Then
Cl.Interior.Color = rgbLightBlue
Cl.Font.Bold = True
Exit For
End If
Next srch
Next Cl
End Sub

VBA 2:
Sub Test3()
Application.ScreenUpdating = False
With ActiveSheet.Columns("A")
.ColumnWidth = 95
.WrapText = True
End With

VBA 3:
Columns("A:B").NumberFormat = "General"
Application.ScreenUpdating = True
End Sub


VBA 4:
Insert Row
Sub testit2()
Worksheets(1).Cells(1, 1).EntireRow.Insert
Debug.Print "| &"; Worksheets(1).Name; "& |", Len(Worksheets(1).Name)
End Sub


VBA 5:
Clear format:
Sub clearformat()
With ActiveSheet.Columns("A")
.Columns(1).ClearFormats 'clear formatting from column A
End With
End Substyle='font-size:9.0pt;font-family:Consolas'>
 
Which line is the error on, I suspect array Academy is not defined
Yes, I changed "Academy" for "study" and it is now working but only on the active worksheet I have on the screen. It is not working on the others for some reason.
 
Upvote 0

Excel Facts

Workdays for a market open Mon, Wed, Friday?
Yes! Use "0101011" for the weekend argument in NETWORKDAYS.INTL or WORKDAY.INTL. The 7 digits start on Monday. 1 means it is a weekend.
Hello Dannottheman,
I don't understand why you don't create one procedure?
Something like this...
VBA Code:
Option Explicit

Sub Dannottheman3()

    Dim Cl As Range
    Dim srch As Variant
    Dim varWS As Worksheet
    
    Application.ScreenUpdating = False
    For Each varWS In Worksheets
        For Each Cl In varWS.Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row)
            For Each srch In Array("quiz", "unit", "exam", "examen", "assessment", "test")
                If " " & LCase(Cl.Value) & " " Like "*[!a-z0-9]" & srch & "[!a-z0-9]*" Then
                    Cl.Interior.Color = rgbLightBlue
                    Cl.Font.Bold = True
                    Exit For
                End If
            Next srch
        Next Cl
        
        With varWS.Columns("A")
            .ColumnWidth = 95
            .WrapText = True
        End With
        
        varWS.Columns("A:B").NumberFormat = "General"
        varWS.Cells(1, 1).EntireRow.Insert
        Debug.Print "| &"; varWS.Name; "& |", Len(varWS.Name)
        
        With varWS.Columns("A")
             .Columns(1).ClearFormats
        End With
    Next
    Application.ScreenUpdating = True
    
End Sub
 
Upvote 0
Yes, I changed "Academy" for "study" and it is now working but only on the active worksheet I have on the screen. It is not working on the others for some reason.
add this line to your sub routine:
VBA Code:
Sub test()
Dim wb As Workbook
Dim ws As Worksheet
For Each wb In Application.Workbooks
If wb.Name <> "PERSONAL.XLSB" Then
For Each ws In wb.Sheets
ws.Select               ' add this line, not the fastest way of doing this but only one line to change
Call Dannottheman3
Next ws
End If
Next wb
End Sub
 
Upvote 0
Hello Dannottheman,
I don't understand why you don't create one procedure?
Something like this...
VBA Code:
Option Explicit

Sub Dannottheman3()

    Dim Cl As Range
    Dim srch As Variant
    Dim varWS As Worksheet
   
    Application.ScreenUpdating = False
    For Each varWS In Worksheets
        For Each Cl In varWS.Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row)
            For Each srch In Array("quiz", "unit", "exam", "examen", "assessment", "test")
                If " " & LCase(Cl.Value) & " " Like "*[!a-z0-9]" & srch & "[!a-z0-9]*" Then
                    Cl.Interior.Color = rgbLightBlue
                    Cl.Font.Bold = True
                    Exit For
                End If
            Next srch
        Next Cl
       
        With varWS.Columns("A")
            .ColumnWidth = 95
            .WrapText = True
        End With
       
        varWS.Columns("A:B").NumberFormat = "General"
        varWS.Cells(1, 1).EntireRow.Insert
        Debug.Print "| &"; varWS.Name; "& |", Len(varWS.Name)
       
        With varWS.Columns("A")
             .Columns(1).ClearFormats
        End With
    Next
    Application.ScreenUpdating = True
   
End Sub
Thanks, this partially works. The first procedure (Cl.Interior.Color = rgbLightBlue) does not work/execute. I get no error, it just doesn't shade the sheet (I am running Excel 2007).
 
Upvote 0
Give some data table example, and we can reorder code.
 
Upvote 0
it just doesn't shade the sheet (I am running Excel 2007).
It probably does, but it's then removed by this part of the code.
VBA Code:
        With varWS.Columns("A")
             .Columns(1).ClearFormats
        End With
 
Upvote 0
It probably does, but it's then removed by this part of the code.
VBA Code:
        With varWS.Columns("A")
             .Columns(1).ClearFormats
        End With
Yes, you are right! OK. I think this is almost working. I need to add this step to the bottom of the code (add row after two other steps have occurred). I tried different combinations but I keep getting different types of errors. Thanks in advance:

Worksheets(1).Cells(1, 1).EntireRow.Insert
Debug.Print "| &"; Worksheets(1).Name; "& |", Len(Worksheets(1).Name)
End Sub

(Working code below)

Option Explicit

Sub Dannottheman3()

Dim Cl As Range
Dim srch As Variant
Dim varWS As Worksheet

Application.ScreenUpdating = False
For Each varWS In Worksheets
For Each Cl In varWS.Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row)
For Each srch In Array("quiz", "unit", "exam", "examen", "assessment", "test")
If " " & LCase(Cl.Value) & " " Like "*[!a-z0-9]" & srch & "[!a-z0-9]*" Then
Cl.Interior.Color = rgbLightBlue
Cl.Font.Bold = True
Exit For
End If
Next srch
Next Cl

With varWS.Columns("A")
.ColumnWidth = 95
.WrapText = True
End With
Next
Application.ScreenUpdating = True

End Sub
 
Upvote 0
Is now better order of the steps?

VBA Code:
Sub Dannottheman3()

    Dim Cl As Range
    Dim srch As Variant
    Dim varWS As Worksheet
    
    Application.ScreenUpdating = False
    For Each varWS In Worksheets
        With varWS.Columns("A")
            .Columns(1).ClearFormats
            .ColumnWidth = 95
            .WrapText = True
        End With
        varWS.Columns("A:B").NumberFormat = "General"
        varWS.Cells(1, 1).EntireRow.Insert
        For Each Cl In varWS.Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row)
            For Each srch In Array("quiz", "unit", "exam", "examen", "assessment", "test")
                If " " & LCase(Cl.Value) & " " Like "*[!a-z0-9]" & srch & "[!a-z0-9]*" Then
                    Cl.Interior.Color = rgbLightBlue
                    Cl.Font.Bold = True
                    Exit For
                End If
            Next srch
        Next Cl
        Debug.Print "| &"; varWS.Name; "& |", Len(varWS.Name)
    Next
    Application.ScreenUpdating = True
    
End Sub
 
Upvote 0

Forum statistics

Threads
1,213,552
Messages
6,114,278
Members
448,560
Latest member
Torchwood72

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top