Try this
Sub ChangeMarker()
Dim Mainhazard As String
Dim numSubs As Long
Dim lastrow As Long
Dim i As Long, ii As Long
With ActiveSheet
lastrow = .Cells(.Rows.Count, "B").End(xlUp).Row
For i = 2 To lastrow
Mainhazard = .Cells(i, "B").Value
numSubs = Application.CountIf(.Range("B2").Resize(lastrow - 1), Left$(Mainhazard, 5) & "**") - 1
With .Cells(i + 1, "G").Resize(numSubs, 4)
For ii = .FormatConditions.Count To 1 Step -1
.FormatConditions(ii).Delete
Next ii
.FormatConditions.Add Type:=xlExpression, _
Formula1:="=" & .Cells(0, -3).Address(True, False) & "<>" & .Cells(1, 1).Address(False, False)
With .FormatConditions(1)
.SetFirstPriority
With .Interior
.PatternColorIndex = xlAutomatic
.Color = 5296274
.TintAndShade = 0
End With
.StopIfTrue = False
End With
End With
i = i + numSubs
Next i
End With
End Sub