Change worksheet tab color if range of cells contains text

Question

I have tried code that I've found here on stackoverflow, and elsewhere but they aren't working as I think they can. I'll list them below. I'm almost certain this is an easy question.

What I'm trying to do: If in any of the cells in the range A2:A100 there is any text or number whatsoever, then make the worksheet tab red. And I will need to do this on over 20 tabs. This must execute upon opening the workbook, and thus not require manually changing a cell or recalculating.

The problems I've had with other code: As far as I can tell they require editing a cell, and then quickly hitting enter again. I tried SHIFT + F9 to recalculate, but this had no effect, as I think this is only for formulas. Code 1 seems to work albeit with having to manually re-enter text, but no matter what color value, I always get a black tab color.

Code I've tried:

Code 1:

Private Sub Worksheet_Change(ByVal Target As Range)
    MyVal = Range("A2:A27").Text

    With ActiveSheet.Tab
        Select Case MyVal
            Case ""
                .Color = xlColorIndexNone
            Case Else
                .ColorIndex = 6
        End Select
    End With
End Sub

Code 2: This is from a stackoverflow question, although I modified the code slightly to fit my needs. Specifically, if in the set range there are no values to leave the tab color alone, and otherwise to change it to color value 6. But I'm sure I've done something wrong, I'm unfamiliar with VBA coding.

Private Sub Worksheet_Calculate()
    If Range("A2:A100").Text = "" Then
        ActiveWorkbook.ActiveSheet.Tab.Color = xlColorIndexNone
    Else
        ActiveWorkbook.ActiveSheet.Tab.Color = 6
    End If
End Sub

Thanks for your help!

I posted this on superuser first, but perhaps stackoverflow is more appropriate since it is explicitly programming-related.

Answer 1

Maybe test the len of the trimmed joined string of cells:

Private Sub Worksheet_Calculate()
    If Len(Trim(Join(Application.Transpose(Range("A2:A100"))))) = 0 Then
        ActiveWorkbook.ActiveSheet.Tab.Color = xlColorIndexNone
    Else
        ActiveWorkbook.ActiveSheet.Tab.Color = 6
    End If
End Sub

This code will fire off every time the sheet calculates though as it is event code, I am not sure if that is what you want? If not then post back and we can drop it into a normal sub for you and make it poll all the sheets to test.

Answer 2

Worksheet_Change function will get called everytime there's change in the target range. You just need to place the code under Worksheet. If you have placed the code in the module or Thisworkbook then it wont work.

Paste the below in Sheet1 of your workbook and check if it works. Of Course you will need to do modification to the below code as I have not written complete code.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim WatchRange As Range
    Dim IntersectRange As Range
    Set WatchRange = Range("A1:A20")
    Set IntersectRange = Intersect(Target, WatchRange)
    If IntersectRange Is Nothing Then
        ''Here undo tab color
    Else
        ActiveSheet.Tab.ColorIndex = 6
    End If

End Sub

Answer 3

Only two things will be able to switch the condition in this statement:

If Range("A2:A100").Text = "" Then

You've already identified both of them, changing the contents of the one of the cells in that range on a worksheet, or a formula in one of those cells recalculating to or from a value of "". As far as event triggers go, if the formula result changes, both the WorkSheet_Calculate and Worksheet_Change events will fire. Of the two, Worksheet_Change is the one to respond to, because WorkSheet_Calculate will only fire if any of the cells in A2:A100 contain a formula. Not if they only contain values - your "Code 2" isn't wrong, the event was just never firing.

The simple solution is to set your tab colors when you open the workbook. That way it doesn't matter if you have to activate a cell in that range and change it - that's only way the value you're testing against is going to change.

I'd do something like this (code in ThisWorkbook):

Option Explicit

Private Sub Workbook_Open()

    Dim sheet As Worksheet
    For Each sheet In Me.Worksheets
        SetTabColor sheet
    Next sheet

End Sub

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

    If Not Intersect(Target, Sh.Range("A2:A100")) Is Nothing Then
        SetTabColor Sh
    End If

End Sub

Private Sub SetTabColor(sheet As Worksheet)
    If sheet.Range("A2:A100").Text = vbNullString Then
        sheet.Tab.Color = xlColorIndexNone
    Else
        sheet.Tab.Color = 6
    End If
End Sub

EDIT: To test for the presence of specific text, you can do the same thing but need to have the test check every cell in the range you're monitoring.

Private Sub SetTabColor(sheet As Worksheet)
    Dim test As Range

    For Each test In sheet.Range("A2:A100")
        sheet.Tab.Color = xlColorIndexNone
        If test.Text = "whatever" Then
            sheet.Tab.Color = vbRed
            Exit For
        End If
    Next test
End Sub