CODEWITHSUNDEEP
vbaexcel
thankseveryone
thankseveryone

Reputation: 127

Apply the same code to multiple worksheets

The VBA below works perfectly fine for Worksheet "X". However, the problem is that I want the same code to be applied simultaneously to worksheet "Y" and "Z" (there are other worksheets as well which do not require this code).

Could you please let me know how to change my VBA below so it refers to worksheets "X", "Y" and "Z" instead of only "X"? thanks in advance. 

Option Explicit

'In a regular module sheet
Public RunWhen As Double    'This statement must go at top of all subs and functions


Sub StartBlink()
    Dim cel As Range

    With ThisWorkbook.Worksheets("X")
        Set cel = .Range("G2")
        If cel.Value > .Range("L3").Value Then
            If cel.Font.ColorIndex = 3 Then    ' Red Text
                cel.Font.ColorIndex = 2        ' White Text
                cel.Interior.ColorIndex = 3
            Else
                cel.Font.ColorIndex = 3        ' Red Text
                cel.Interior.ColorIndex = xlColorIndexAutomatic
            End If
        Else
            cel.Font.ColorIndex = 3             'Red text
            cel.Interior.ColorIndex = xlColorIndexAutomatic
        End If
    End With

    RunWhen = Now + TimeSerial(0, 0, 1)
    Application.OnTime RunWhen, "'" & ThisWorkbook.Name & "'!StartBlink", ,  True
End Sub


Sub StopBlink()
    On Error Resume Next
        Application.OnTime RunWhen, "'" & ThisWorkbook.Name & "'!StartBlink", ,   False
    On Error GoTo 0

    With ThisWorkbook.Worksheets("X")
        .Range("G2").Font.ColorIndex = 3
        .Range("G2").Interior.ColorIndex = xlColorIndexAutomatic
    End With
End Sub


Sub xStopBlink()
    On Error Resume Next
        Application.OnTime RunWhen, "'" & ThisWorkbook.Name & "'!StartBlink", , False
    On Error GoTo 0
    ThisWorkbook.Worksheets("X").Range("L3").Font.ColorIndex = 3
End Sub

Upvotes: 0

Views: 127

Answers (4)

YowE3K
YowE3K

Reputation: 23974

Just loop through each of the three sheets:

Sub StartBlink()
    Dim cel As Range
    Dim ws As Worksheet

    For Each ws In ThisWorkbook.Worksheets(Array("X", "Y", "Z"))
        With ws
            Set cel = .Range("G2")
            If cel.Value > .Range("L3").Value Then
                If cel.Font.ColorIndex = 3 Then    ' Red Text
                    cel.Font.ColorIndex = 2        ' White Text
                    cel.Interior.ColorIndex = 3
                Else
                    cel.Font.ColorIndex = 3        ' Red Text
                    cel.Interior.ColorIndex = xlColorIndexAutomatic
                End If
            Else
                cel.Font.ColorIndex = 3             'Red text
                cel.Interior.ColorIndex = xlColorIndexAutomatic
            End If
        End With

    Next

    RunWhen = Now + TimeSerial(0, 0, 1)
    Application.OnTime RunWhen, "'" & ThisWorkbook.Name & "'!StartBlink", ,  True
End Sub

Sub StopBlink()
    On Error Resume Next
        Application.OnTime RunWhen, "'" & ThisWorkbook.Name & "'!StartBlink", ,   False
    On Error GoTo 0

    Dim ws As Worksheet

    For Each ws In ThisWorkbook.Worksheets(Array("X", "Y", "Z"))
        With ws
            .Range("G2").Font.ColorIndex = 3
            .Range("G2").Interior.ColorIndex = xlColorIndexAutomatic
        End With
    Next
End Sub

Upvotes: 4

Michał Turczyn
Michał Turczyn

Reputation: 37337

I think you need Activate method: ThisWorkbook.Worksheets("name").Activate.

From MSDN: Calling this method is equivalent to clicking the sheet's tab.

Try this:

Sub tt()

Dim sheets As Variant, s As Variant
sheets = Array("X", "Y", "Z", ...)

For Each s In sheets
    ThisWorkbook.Worksheets(s).Activate
    ' call your sub here
Next s

End Sub

Upvotes: -1

Romcel Geluz
Romcel Geluz

Reputation: 603

try adding an argument for your subs, like

Option Explicit

'In a regular module sheet
Public RunWhen As Double    'This statement must go at top of all subs and functions

Public wsReference As Worksheet

Sub StartBlink(ByVal NewWsName As Worksheet)
    Dim cel As Range
    Set wsReference = NewWsName
    With NewWsName
        Set cel = .Range("G2")
        If cel.Value > .Range("L3").Value Then
            If cel.Font.ColorIndex = 3 Then    ' Red Text
                cel.Font.ColorIndex = 2        ' White Text
                cel.Interior.ColorIndex = 3
            Else
                cel.Font.ColorIndex = 3        ' Red Text
                cel.Interior.ColorIndex = xlColorIndexAutomatic
            End If
        Else
            cel.Font.ColorIndex = 3             'Red text
            cel.Interior.ColorIndex = xlColorIndexAutomatic
        End If
    End With

    RunWhen = Now + TimeSerial(0, 0, 1)
    Application.OnTime RunWhen, "'" & ThisWorkbook.Name & "'!StartBlink", , True
End Sub

Sub StopBlink()
    On Error Resume Next
        Application.OnTime RunWhen, "'" & ThisWorkbook.Name & "'!StartBlink", , False
    On Error GoTo 0

    With wsReference
        .Range("G2").Font.ColorIndex = 3
        .Range("G2").Interior.ColorIndex = xlColorIndexAutomatic
    End With
End Sub

Sub xStopBlink()
    On Error Resume Next
        Application.OnTime RunWhen, "'" & ThisWorkbook.Name & "'!StartBlink", , False
    On Error GoTo 0
    wsReference.Range("L3").Font.ColorIndex = 3
End Sub

and should be called like

startblink thisworkbook.sheets("X")
startblink thisworkbook.sheets("Y")

posting this code without testing

Upvotes: 2

Hocus
Hocus

Reputation: 121

This can can be modified to check the conditions 1 by 1 in each sheet and then update, but you cannot have multiple scripts running at the same time.

This should work:

Option Explicit

'In a regular module sheet
Public RunWhen As Double    'This statement must go at top of all subs and functions


Sub StartBlink()
    Dim cel As Range

    With ThisWorkbook.Worksheets("X")
        Set cel = .Range("G2")
        If cel.Value > .Range("L3").Value Then
            If cel.Font.ColorIndex = 3 Then    ' Red Text
                cel.Font.ColorIndex = 2        ' White Text
                cel.Interior.ColorIndex = 3
            Else
                cel.Font.ColorIndex = 3        ' Red Text
                cel.Interior.ColorIndex = xlColorIndexAutomatic
            End If
        Else
            cel.Font.ColorIndex = 3             'Red text
            cel.Interior.ColorIndex = xlColorIndexAutomatic
        End If
    End With

    With ThisWorkbook.Worksheets("y")
        Set cel = .Range("G2")
        If cel.Value > .Range("L3").Value Then
            If cel.Font.ColorIndex = 3 Then    ' Red Text
                cel.Font.ColorIndex = 2        ' White Text
                cel.Interior.ColorIndex = 3
            Else
                cel.Font.ColorIndex = 3        ' Red Text
                cel.Interior.ColorIndex = xlColorIndexAutomatic
            End If
        Else
            cel.Font.ColorIndex = 3             'Red text
            cel.Interior.ColorIndex = xlColorIndexAutomatic
        End If
    End With

    With ThisWorkbook.Worksheets("z")
        Set cel = .Range("G2")
        If cel.Value > .Range("L3").Value Then
            If cel.Font.ColorIndex = 3 Then    ' Red Text
                cel.Font.ColorIndex = 2        ' White Text
                cel.Interior.ColorIndex = 3
            Else
                cel.Font.ColorIndex = 3        ' Red Text
                cel.Interior.ColorIndex = xlColorIndexAutomatic
            End If
        Else
            cel.Font.ColorIndex = 3             'Red text
            cel.Interior.ColorIndex = xlColorIndexAutomatic
        End If
    End With







    RunWhen = Now + TimeSerial(0, 0, 1)
    Application.OnTime RunWhen, "'" & ThisWorkbook.Name & "'!StartBlink", ,  True
End Sub


Sub StopBlink()
    On Error Resume Next
        Application.OnTime RunWhen, "'" & ThisWorkbook.Name & "'!StartBlink", ,   False
    On Error GoTo 0

    With ThisWorkbook.Worksheets("X")
        .Range("G2").Font.ColorIndex = 3
        .Range("G2").Interior.ColorIndex = xlColorIndexAutomatic
    End With
    With ThisWorkbook.Worksheets("y")
        .Range("G2").Font.ColorIndex = 3
        .Range("G2").Interior.ColorIndex = xlColorIndexAutomatic
    End With
    With ThisWorkbook.Worksheets("z")
        .Range("G2").Font.ColorIndex = 3
        .Range("G2").Interior.ColorIndex = xlColorIndexAutomatic
    End With
End Sub


Sub xStopBlink()
    On Error Resume Next
        Application.OnTime RunWhen, "'" & ThisWorkbook.Name & "'!StartBlink", , False
    On Error GoTo 0
    ThisWorkbook.Worksheets("X").Range("L3").Font.ColorIndex = 3
    ThisWorkbook.Worksheets("y").Range("L3").Font.ColorIndex = 3
    ThisWorkbook.Worksheets("z").Range("L3").Font.ColorIndex = 3
End Sub

Upvotes: 0

Related Questions