Option Explicit
Sub test()
Dim i As Integer, j As Integer, c As Range, k As Byte
Range("A7:I" & Range("A65536").End(xlUp).Row).ClearFormats
For i = 7 To Range("A65536").End(xlUp).Row - 1
If Cells(i, 8).Value = Cells(i + 1, 8).Value Then
For j = i + 1 To Range("A65536").End(xlUp).Row
If Cells(i, 8).Value <> Cells(j, 8).Value Or IsEmpty(Cells(j + 1, 8).Value) Then
If IsEmpty(Cells(j + 1, 8).Value) Then k = 0 Else k = 1
With Range(Cells(i, 1), Cells(j - k, 9))
With .Borders
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlColorIndexAutomatic
End With
With .Borders(xlInsideVertical)
.LineStyle = xlDot
.Weight = xlThin
.ColorIndex = xlColorIndexAutomatic
End With
With .Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlColorIndexAutomatic
End With
End With
i = j - 1
Exit For
End If
Next j
Else
With Range(Cells(i, 1), Cells(i, 9))
With .Borders
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlColorIndexAutomatic
End With
With .Borders(xlInsideVertical)
.LineStyle = xlDot
.Weight = xlThin
.ColorIndex = xlColorIndexAutomatic
End With
End With
End If
Next i
End Sub