chuck22
chuck22

Reputation: 45

Loop to check condition

I need to check at every cells change a certain condition, I wrote this one, but it doesn't work, what's wrong?

In every sheet:

Private Sub Worksheet_Change(ByVal Target As Range)
 ColoraLabel.ColoraLabel (ActiveSheet.Name) 
End sub

In the module I've written:

Public Function ColoraLabel(nomeFoglio)

Dim WS_Count As Integer
Dim I As Integer
Set Foglio = Sheets(nomeFoglio)
Set Target = Foglio.Range("f21")
     WS_Count = ActiveWorkbook.Worksheets.Count
     For I = 1 To WS_Count
        MsgBox ActiveWorkbook.Worksheets(I).Name
        Set Foglio = ActiveWorkbook.Worksheets(I).Name
        Set Target = Foglio.Range("f21")

        If Target = "1" Then
            Foglio.Tab.ColorIndex = 4
        Else
             Foglio.Tab.ColorIndex = xlNone
        End If
     Next I
End Function

Upvotes: 0

Views: 60

Answers (1)

Shai Rado
Shai Rado

Reputation: 33672

Put the code below in the Workbook_SheetChange event, instead os putting the same piece of code in every worksheet (especialy that you need the same code for all your worksheets).

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

Dim Sht As Worksheet, Foglio As Worksheet
Dim TargetRng As Range

For Each Sht In Worksheets
    MsgBox Sht.Name

    Set Foglio = Sheets(Sht.Name)
    Set TargetRng = Foglio.Range("F21")

    If TargetRng = "1" Then
        Foglio.Tab.ColorIndex = 4
    Else
        Foglio.Tab.ColorIndex = xlNone
    End If

Next Sht

End Sub

However, since your code checks the value in cell "F21" and changes the Sheet.tab color according to the value found in Range("F21"), you can run the minimized and cleaner code version below:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

' why scan all cells, if the only thing your function checks is the value of "F21"
If Not Intersect(Range("F21"), Target) Is Nothing Then
    If Target = "1" Then
        Sh.Tab.ColorIndex = 4
    Else
        Sh.Tab.ColorIndex = xlNone
    End If

End If

End Sub

Upvotes: 1

Related Questions