1

Trying to have VBA loop through sheets and color tab red if K1 on each sheet is > 0. What I have so far fails to loop through sheets, just colors active sheet:

    Sub IfJNegRedTab()
'
'
'
Dim sht As Worksheet

For Each sht In ActiveWorkbook.Worksheets

Range("K1").Select
ActiveCell.FormulaR1C1 = "=COUNTIF(C[-1],""<0"")"

If Range("K1").Value > 0 Then
With ActiveWorkbook.ActiveSheet.Tab
        .Color = 255
        .TintAndShade = 0
End With
End If
Next sht
'
End Sub
Alex
  • 55
  • 2
  • 13

1 Answers1

1

Always make sure you're referencing the intended sheet. Having simply Range(A1) will refer to the active sheet. You need to do Sheets("MySheet").Range(A1). Note it's also best practice to avoid using .Select/.Activate

Sub IfJNegRedTab()
Dim sht     As Worksheet

For Each sht In ActiveWorkbook.Worksheets
    With sht
        .Range("K1").FormulaR1C1 = "=COUNTIF(C[-1],""<0"")"
        If .Range("K1").Value > 0 Then
            With .Tab
                .Color = 255
                .TintAndShade = 0
            End With
        End If
    End With
Next sht
End Sub

Also the formula in K1 just being used to check the column to the left's value can be removed:

Sub IfJNegRedTab_v2()
Dim sht     As Worksheet

For Each sht In ActiveWorkbook.Worksheets
    With sht
        If .Range("K1").Offset(0, -1).Value < 0 Then
            With .Tab
                .Color = 255
                .TintAndShade = 0
            End With
        End If
    End With
Next sht
End Sub
BruceWayne
  • 22,923
  • 15
  • 65
  • 110
  • Bruce, re: v2 - formula is being put into K1 to count number of occurrences of negative numbers in column J, and if that number is greater than none, then color the tab red. I can't tell without trying in Excel and am not near Excel now, but will try the code tomorrow. Hopefully, what you mean is that v2 will be able to evaluate the condition without actually pasting a formula into K1. – Alex May 16 '18 at 22:23
  • Bruce, v2 did not work at all and no errors. First version worked a treat - Thank You for your solution. Can you also make the red tabs group upfront and tabs remained not colored to group at the end? @BruceWayne – Alex May 17 '18 at 12:36
  • Found below code which works to group tabs by color: 'Sub GroupSheetsByColor() Dim lCount As Long, lCounted As Long Dim lShtLast As Long lShtLast = Sheets.Count For lCount = 1 To lShtLast For lCounted = lCount To lShtLast If Sheets(lCounted).Tab.ColorIndex = Sheets(lCount).Tab.ColorIndex Then Sheets(lCounted).Move Before:=Sheets(lCount) End If Next lCounted Next lCount End Sub' – Alex May 17 '18 at 13:48
  • @Alex - These should be new questions if you haven't figured out how to do it. – BruceWayne May 17 '18 at 14:19
  • code I pasted just above does work to group tabs by color, figured may be useful for somebody as well. Thanks again! – Alex May 17 '18 at 15:56