Reputation: 45
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
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