Private Sub Worksheet_Change(ByVal Target As Excel.Range) Dim myRng As Range, cl As Range, tstVal As String, tmpBool As Boolean If Intersect(Target, Me.Range("B28:BJ29")) Is Nothing Then _ Exit Sub Me.Unprotect Set myRng = Intersect(Target, Me.Range("B28:BJ29")) Let tstVal = Worksheets("Check-Working Data").Range("a1").Value Application.ScreenUpdating = False For Each cl In myRng With cl If .Value = tstVal Then .Font.ColorIndex = 5 .Interior.ColorIndex = xlColorIndexNone .Interior.Pattern = xlPatternNone Else .Font.ColorIndex = 2 .Interior.ColorIndex = 3 .Interior.Pattern = xlSolid tmpBool = True End If End With Next Me.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True If tmpBool Then With Sheets("working data") .Unprotect .Range("A3:A6").Font.ColorIndex = 2 With .Range("A3:A6").Interior .ColorIndex = 3 .Pattern = xlSolid .PatternColorIndex = xlAutomatic End With .Protect DrawingObjects:=True, Contents:=True, Scenarios:=True .Select End With End If Application.ScreenUpdating = True End Sub