Worksheet Change on multiple sheets

[imback2nite]

I have this code on Sheets 13 through 42. IS there a way I can write this code once and have it react on just these sheets? Thank you in advance!!

Private Sub Worksheet_Change(ByVal Target As Range)

Dim cell As Range
Dim Rng1 As Range
 On Error Resume Next
    Set Rng1 = ActiveSheet.Cells.SpecialCells(xlCellTypeFormulas, 1)
    On Error GoTo 0
    If Rng1 Is Nothing Then
        Set Rng1 = Range(Target.Address)
    Else
        Set Rng1 = Union(Range(Target.Address), Rng1)
    End If
    For Each cell In Rng1
        Select Case cell.Value
        Case vbNullString
            cell.Interior.ColorIndex = xlNone
            cell.Font.Bold = False
        Case Range("H3").Value
            cell.Interior.ColorIndex = 6
            cell.Font.Bold = True
            cell.Font.ColorIndex = 1
        Case Range("H4").Value
            cell.Interior.ColorIndex = 43
            cell.Font.Bold = True
            cell.Font.ColorIndex = 1
        Case Range("H5").Value
            cell.Interior.ColorIndex = 54
            cell.Font.Bold = True
            cell.Font.ColorIndex = 2
        Case Range("H6").Value
            cell.Interior.ColorIndex = 39
            cell.Font.Bold = True
            cell.Font.ColorIndex = 1
        Case Range("H7").Value
            cell.Interior.ColorIndex = 2
            cell.Font.Bold = True
            cell.Font.ColorIndex = 1
        Case Range("H8").Value
            cell.Interior.ColorIndex = 30
            cell.Font.Bold = True
            cell.Font.ColorIndex = 2
        Case Range("H9").Value
            cell.Interior.ColorIndex = 39
            cell.Font.Bold = True
            cell.Font.ColorIndex = 1
        Case Range("P3").Value
            cell.Interior.ColorIndex = 26
            cell.Font.Bold = True
            cell.Font.ColorIndex = 1
        Case Range("P4").Value
            cell.Interior.ColorIndex = 46
            cell.Font.Bold = True
            cell.Font.ColorIndex = 1
        Case Range("P5").Value
            cell.Interior.ColorIndex = 3
            cell.Font.Bold = True
            cell.Font.ColorIndex = 2
        Case Range("P6").Value
            cell.Interior.ColorIndex = 53
            cell.Font.Bold = True
            cell.Font.ColorIndex = 2
        Case Range("P7").Value
            cell.Interior.ColorIndex = 29
            cell.Font.Bold = True
            cell.Font.ColorIndex = 2
        Case Range("P8").Value
            cell.Interior.ColorIndex = 40
            cell.Font.Bold = True
            cell.Font.ColorIndex = 1
        Case Range("P9").Value
            cell.Interior.ColorIndex = 10
            cell.Font.Bold = True
            cell.Font.ColorIndex = 2
        Case Range("Y3").Value
            cell.Interior.ColorIndex = 35
            cell.Font.Bold = True
            cell.Font.ColorIndex = 1
        Case Range("Y4").Value
            cell.Interior.ColorIndex = 10
            cell.Font.Bold = True
            cell.Font.ColorIndex = 2
        Case Range("Y5").Value
            cell.Interior.ColorIndex = 5
            cell.Font.Bold = True
            cell.Font.ColorIndex = 2
        Case Range("Y6").Value
            cell.Interior.ColorIndex = 16
            cell.Font.Bold = True
            cell.Font.ColorIndex = 1
        Case Range("Y7").Value
            cell.Interior.ColorIndex = 42
            cell.Font.Bold = True
            cell.Font.ColorIndex = 1
        Case Range("Y8").Value
            cell.Interior.ColorIndex = 4
            cell.Font.Bold = True
            cell.Font.ColorIndex = 1
        Case Range("Y9").Value
            cell.Interior.ColorIndex = 46
            cell.Font.Bold = True
            cell.Font.ColorIndex = 2
        Case Range("AF3").Value
            cell.Interior.ColorIndex = 34
            cell.Font.Bold = True
            cell.Font.ColorIndex = 1
        Case Range("AF4").Value
            cell.Interior.ColorIndex = 38
            cell.Font.Bold = True
            cell.Font.ColorIndex = 1
        Case Range("AF5").Value
            cell.Interior.ColorIndex = 8
            cell.Font.Bold = True
            cell.Font.ColorIndex = 1
        Case Range("AF6").Value
            cell.Interior.ColorIndex = 47
            cell.Font.Bold = True
            cell.Font.ColorIndex = 2
        Case Range("AF7").Value
            cell.Interior.ColorIndex = 12
            cell.Font.Bold = True
            cell.Font.ColorIndex = 2
        Case Range("AF8").Value
            cell.Interior.ColorIndex = 33
            cell.Font.Bold = True
            cell.Font.ColorIndex = 1
        Case Range("AF9").Value
            cell.Interior.ColorIndex = 53
            cell.Font.Bold = True
            cell.Font.ColorIndex = 2
        Case Else
            cell.Interior.ColorIndex = xlNone
            cell.Font.Bold = False
        End Select
    Next
End Sub

 

[imback2nite]

If you're using 2003 just use Count rather than CountLarge as CountLarge didn't exist then (didn't need to with the number of cells in 2003)

Well, so far, this seems to be working. You've really gone the extra mile! Thank you so much!!

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    'Modified  8/30/2022  10:32:06 PM  EDT

    Select Case ActiveSheet.Index
        Case 14 To 44
        If Target.Cells.Count > 1 Or IsEmpty(Target) Then: Target.Interior.ColorIndex = xlNone: Target.Font.Bold = False: Exit Sub
            If Target = Worksheets("Tally Sheet").Range("Z3") Then: Target.Interior.ColorIndex = 6: Target.Font.Bold = True: Target.Font.ColorIndex = 1
            If Target = Worksheets("Tally Sheet").Range("Z4") Then: Target.Interior.ColorIndex = 43: Target.Font.Bold = True: Target.Font.ColorIndex = 1
    End Select
End Sub

 

[My Aswer Is This]

Well, so far, this seems to be working. You've really gone the extra mile! Thank you so much!!

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    'Modified  8/30/2022  10:32:06 PM  EDT

    Select Case ActiveSheet.Index
        Case 14 To 44
        If Target.Cells.Count > 1 Or IsEmpty(Target) Then: Target.Interior.ColorIndex = xlNone: Target.Font.Bold = False: Exit Sub
            If Target = Worksheets("Tally Sheet").Range("Z3") Then: Target.Interior.ColorIndex = 6: Target.Font.Bold = True: Target.Font.ColorIndex = 1
            If Target = Worksheets("Tally Sheet").Range("Z4") Then: Target.Interior.ColorIndex = 43: Target.Font.Bold = True: Target.Font.ColorIndex = 1
    End Select
End Sub

Glad I was able to help you.
Come back here to Mr. Excel next time you need additional assistance.