Change Tab Color based on dynamic cell value

[crazi4sports10]

I need to change the tab color based on the value found under the words "inception difference" in that tab. The tabs have between 1-10 numbers below "inception difference." If all numbers below "inception difference" are negative, make the tab red. If they are all positive, make the tab green. If some are negative and some are positive, make the tab yellow.

 

[tonyyy]

Is there always at least one blank cell below "inception difference"?

 

[crazi4sports10]

Yes, but always after at least 1 value (and up to 25)

 

[tonyyy]

Sub InceptionDifference()

Dim LastRow As Long
Dim LastColumn As Integer
Dim id As Range
Dim sht As Worksheet
Dim i As Long
Dim r As Range

For i = 1 To ThisWorkbook.Worksheets.Count
    Worksheets(i).Activate
    Set r = Nothing
    Set id = Nothing
    
    If WorksheetFunction.CountA(Cells) > 0 Then
        LastRow = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        LastColumn = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
    
        Set r = Range(Cells(1, 1), Cells(LastRow, LastColumn))
        Set id = r.Find(What:="inception difference", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
            
        Dim idLastRow As Long
        Dim idFirstRow As Long
        Dim r2 As Range
        Set r2 = Nothing
    
    If id.Value <> "" Then
        If id.Offset(1, 0) <> "" Then
            idFirstRow = id.Offset(1, 0).Row
            idLastRow = id.End(xlDown).Row
        Else
            idFirstRow = id.End(xlDown).Row
            idLastRow = id.End(xlDown).End(xlDown).Row
        End If

    Set r2 = Range(Cells(idFirstRow, id.Column), Cells(idLastRow, id.Column))

        If Application.CountIf(r2, "<0") = r2.Count Then
            ActiveWorkbook.Sheets(i).Tab.Color = 255
        Else
            If Application.CountIf(r2, ">0") = r2.Count Then
                ActiveWorkbook.Sheets(i).Tab.Color = 5287936
            Else
                ActiveWorkbook.Sheets(i).Tab.Color = 65535
                End If
            End If
        End If
    End If
Next i
    
End Sub

The code may not be pretty - some may even call it ugly - but I think it works...

Cheers,

tonyyy

 

[crazi4sports10]

Although I am no expert, I understand and agree with the rationale in the code. Unfortunately, not there yet - the Macro with your most recent code gives "Run-time error '91': Object variable or With block variable not set" - when I try to debug the error, it highlights 'If id.Value <> "" Then' - other thoughts?

 

[tonyyy]

Try replacing the error line with...

If Not id Is Nothing Then

 

[crazi4sports10]

Golden!! Works like a charm - one more small request. IF one of the tabs has "inception difference" and then doesn't have a value under it, can you highlight it black so I know to address the missing data? Otherwise it's good to go!