Insert blank row if more than same month date - VBA

[adino8]

Hi guys
Here's my problem
I'm trying to insert blank row in my data sheet in every group number given (ex. before 2 or 5 rows) based on month.
It will insert new blank row if there's more than one same month date (ex. September) and if there is another month (ex. October) it will start counting based on new month and insert new blank row only if more than one October date' appears.

I have this:

17-01-2022 - Daty i sumy spłat w PLN i CHF.xlsx
	A	B	C	D
1	Data	Wysokość raty kapitałowej w CHF	Wysokość raty odsetkowej w CHF	Razem rata kapitałowo - odsetkowa w CHF
2	12 lip 06	0.00 CHF	257.74 CHF	257.74 CHF
3	31 lip 06	885.98 CHF	1,551.89 CHF	2,437.87 CHF
4	30 sie 06	883.24 CHF	1,547.24 CHF	2,430.48 CHF
5	1 wrz 06	0.00 CHF	0.00 CHF	0.00 CHF
6	2 paź 06	899.86 CHF	1,543.65 CHF	2,443.51 CHF
7	6 lis 06	865.09 CHF	1,636.90 CHF	2,501.99 CHF
8	1 gru 06	868.60 CHF	1,580.37 CHF	2,448.97 CHF
9	2 sty 07	873.02 CHF	1,629.23 CHF	2,502.25 CHF
10	24 sty 07	830.88 CHF	1,651.83 CHF	2,482.71 CHF
11	19 lut 07	8.07 CHF	0.01 CHF	8.08 CHF
12	26 lut 07	10.26 CHF	8.41 CHF	18.67 CHF
13	6 mar 07	853.22 CHF	1,705.73 CHF	2,558.95 CHF
14	3 kwi 07	857.25 CHF	1,791.49 CHF	2,648.74 CHF
Arkusz

Cell Formulas
Range	Formula
D2:D4,D6:D14	D2	=B2+C2

I want to be like this:

17-01-2022 - Daty i sumy spłat w PLN i CHF.xlsx
	A	B	C	D
1	Data	Wysokość raty kapitałowej w CHF	Wysokość raty odsetkowej w CHF	Razem rata kapitałowo - odsetkowa w CHF
2
3	12 lip 06	0.00 CHF	257.74 CHF	257.74 CHF
4	31 lip 06	885.98 CHF	1,551.89 CHF	2,437.87 CHF
5	30 sie 06	883.24 CHF	1,547.24 CHF	2,430.48 CHF
6	1 wrz 06	0.00 CHF	0.00 CHF	0.00 CHF
7	2 paź 06	899.86 CHF	1,543.65 CHF	2,443.51 CHF
8	6 lis 06	865.09 CHF	1,636.90 CHF	2,501.99 CHF
9	1 gru 06	868.60 CHF	1,580.37 CHF	2,448.97 CHF
10
11	2 sty 07	873.02 CHF	1,629.23 CHF	2,502.25 CHF
12	24 sty 07	830.88 CHF	1,651.83 CHF	2,482.71 CHF
13
14	19 lut 07	8.07 CHF	0.01 CHF	8.08 CHF
15	26 lut 07	10.26 CHF	8.41 CHF	18.67 CHF
16	6 mar 07	853.22 CHF	1,705.73 CHF	2,558.95 CHF
17	3 kwi 07	857.25 CHF	1,791.49 CHF	2,648.74 CHF
Arkusz

Cell Formulas
Range	Formula
D3:D5,D14:D17,D11:D12,D7:D9	D3	=B3+C3

Can you help me guys. Thanks!

 

[rollis13]

Have a try with my macro (it will check if same month but not if different year) to be pasted in a vbe module:

Option Explicit
Sub InsertBlankRow()
    Dim lr     As Long
    Dim ar     As Long
    Dim ar2    As Long
    Dim flag   As Boolean
    Application.ScreenUpdating = False
    lr = Range("A" & Rows.Count).End(xlUp).Row
    For ar = lr To 3 Step -1
        ar2 = ar
        If Month(Range("A" & ar)) = Month(Range("A" & ar2 - 1)) Then
            flag = True
            Do
                ar2 = ar2 - 1
                If ar2 > 2 Then
                    If Month(Range("A" & ar)) = Month(Range("A" & ar2 - 1)) Then
                        ar2 = ar2 - 1
                    Else
                        flag = False
                    End If
                End If
                flag = False
            Loop Until flag = False
            Range("A" & ar2).EntireRow.Insert Shift:=xlDown
            Range("A" & ar2).EntireRow.ClearFormats
            ar = ar2
        End If
    Next ar
    Application.ScreenUpdating = True
    MsgBox "Done!"
End Sub