Macro Sub-Totales, en cambios de Mes

Buenas Tardes, tengo la siguiente macro, que determina el cambio en periodo (mes) y en la celda que detecta este, inserta una fila, en la cual establece el sub-total, y posteriormente continua analizando los datos hasta encontrar otro cambio:

Sub Segundo_Intento()
Dim a
a = Range("B" & Rows.Count).End(xlUp).Row
For b = 13 To a
Select Case Month(Cells(b, 2)) = Month(Cells(b + 1, 2))
Case True
Case False
b = b + 1
Rows(b).Insert Shift:=xlDown
With Cells(b, 2)
.Value = "TOTAL " & UCase(Format(Cells(b - 1, 2).Value, "mmmm yyyy"))
.HorizontalAlignment = xlCenter
.Font.Bold = True
End With
With Cells(b, 3)
'.FormulaR1C1 = "=SUBTOTAL(9,R" & b & "C:R[-1]C)" Esta parte no funciona correctamente
.Font.Bold = True
End With
i = a + 1
ReDim a(i) As Integer 'Esta parte no funciona
End Select
Next b
End Sub

Agradezco tu tiempo, espero me puedas ayudar