Snasui Excel Forum

Code: Select all

Dim r As Long, lr As Long, i
Application.ScreenUpdating = False
i = Array("", "OBSERVATIONS", "VIOLATIONS", "TOTAL", "")
lr = Cells(Rows.Count, 1).End(xlUp).Row + 1
For r = lr To 3 Step -1
  If Cells(r, 1) <> Cells(r - 1, 1) Then
    Rows(r).Resize(5).Insert
    Cells(r, 1).Resize(5).Value = Application.Transpose(i)
    Cells(r, 1).Resize(, 2).Interior.ColorIndex = 15
    Cells(r + 1, 1).Resize(3).Font.Bold = True
    Cells(r + 4, 1).Resize(, 2).Interior.ColorIndex = 15
  End If
Next r
Columns(1).AutoFit
Application.ScreenUpdating = True