Sub Test()
Dim c As Range, rw As Range, fa As String
Application.ScreenUpdating = False
With Columns("A")
Set c = .Find("Regeneration", LookIn:=xlValues, LookAT:=xlPart)
If Not c Is Nothing Then
fa = c.Address
Do
If c.MergeArea.Cells.Count > 1 Then
For Each rw In c.MergeArea.Cells
rw.EntireRow.Interior.ColorIndex = 4
Next rw
c.MergeArea.Interior.ColorIndex = 4
Else
c.EntireRow.Interior.ColorIndex = 4
End If
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> fa
End If
End With
Application.ScreenUpdating = True
End Sub