Selecting Ranges Based on Cells with same Values

try it

Sub ert()
Dim i&, r As Range
Application.ScreenUpdating = False
For i = 4 To Cells(Rows.Count, 1).End(xlUp).Row
    Set r = Cells(i, 1)
    Do While Cells(i, 1) = Cells(i + 1, 1)
        Set r = Union(r, Cells(i + 1, 1))
        i = i + 1
    Loop
    r.Offset(, 8).Merge: r.Offset(, 9).Merge
Next i
Application.ScreenUpdating = True
End Sub