Sub TEST()
Dim xArea As Range, Arr, i&, T$, N&
Set xArea = Range([B2], [B65536].End(xlUp))
Arr = xArea
For i = 1 To xArea.Count
If xArea(i) <> T Then N = 1: T = xArea(i)
Arr(i, 1) = T & "_" & Format(N, "00")
If xArea(i).Interior.ColorIndex <> xlNone Then N = N + 1
Next i
[A2].Resize(xArea.Count) = Arr
End Sub