Option Explicit
Option Compare Text 'Makes all text comparisons case insensitive
Sub Macro2()
Dim wsSrc As Worksheet
Dim lngRow As Long, lngRowFrom As Long, lngRowTo As Long
Dim strKey As String
Set wsSrc = ThisWorkbook.Sheets("Sheet1") 'Sheet name containing the data. Change to suit if necessary.
Application.ScreenUpdating = False
With wsSrc
lngRowFrom = 2
lngRowTo = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
.Range("A" & lngRowFrom & ":H" & lngRowTo).Interior.Color = xlNone 'Clear all previous shading. Assumes date is in columns A to H. Change to suit.
For lngRow = lngRowFrom To lngRowTo
Select Case True
Case .Range("B" & lngRow) = "Good/Fair-Good" And .Range("G" & lngRow) = 0 And .Range("H" & lngRow) <= 10 'Rule 1
.Range("B" & lngRow & ",G" & lngRow & ":H" & lngRow).Interior.Color = RGB(0, 255, 0) 'Matching cells are coloured green. Change to suit.
Case .Range("B" & lngRow) = "Good/Fair-Good" And .Range("G" & lngRow) = 1 And .Range("H" & lngRow) <= 10 'Rule 2
.Range("B" & lngRow & ",G" & lngRow & ":H" & lngRow).Interior.Color = RGB(0, 255, 0) 'Matching cells are coloured green. Change to suit.
End Select
Next lngRow
End With
Application.ScreenUpdating = True
End Sub