Private Sub Worksheet_Change(ByVal Target As Excel.Range) Dim myRng As Range, cl As Range, tstVal As String If Intersect(Target, Me.Range("B8:B13,F8:F11,F13:F15,B54:B57")) Is Nothing Then _ Exit Sub Me.Unprotect Set myRng = Intersect(Target, Me.Range("B8:B13,F8:F11,F13:F15,B54:B57")) 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 End If End With Next Application.ScreenUpdating = True Me.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True End Sub