Insert new row based on a cells date

[skpma]

Hello everyone

I was searching around, but wasn't able to find a solution for my problem.

I have the following list:

Datalist.xlsx
	A	B	C
1	Title A	Title B	Date
2	123456	A	2020/12/7
3	1234567	B	2020/12/15
4	123456778	C	2021/1/1
5	87654321	M	2021/1/1
6	987654321	G	2021/12/14
Sheet1

Now what I need is to check the cell value in column C if the entries are still in the same month, if not add a new row above that cell and write the corresponding month into column A.
It should look like this:

Book1
	A	B	C
1	Title A	Title B	Date
2	December
3	123456	A	2020/12/7
4	1234567	B	2020/12/15
5	January
6	123456778	C	2021/1/1
7	87654321	M	2021/1/1
8	April
9	987654321	G	2021/4/14
Sheet1

I found the following code, which adds new rows if the date changes, but I can't make it work to check only the month.

Sub InsertAtDateChange()
Dim lastRow, chkRw As Integer
 lastRow = Range("C" & Rows.Count).End(xlUp).Row
   For chkRw = lastRow To 1 Step -1
     If Range("C" & chkRw) <> Range("C" & chkRw + 1) Then
        Range("C" & chkRw + 1).EntireRow.Insert shift:=xlDown
     End If
   Next
End Sub

Any help is appreciated. Thanks in advance

 

[JLGWhiz]

See if this does what you want:

Sub ta()
Dim i As Long
With ActiveSheet
    For i = .Cells(Rows.Count, 3).End(xlUp).Row To 2 Step -1
        If Month(.Cells(i, 3).Value) <> Month(.Cells(i - 1, 3).Value) And Not Application.IsText(.Cells(i - 1, 1)) Then
            Rows(i).Insert
            .Cells(i, 1) = Format(.Cells(i + 1, 3).Value, "mmmm")
        End If
    Next
End With
End Sub

 

[skpma]

See if this does what you want:

Thank you for your reply.
Unfortunately I get an VB error stating that the format is not correct. If I delete the title header it does nothing. Do I have to change some formats?

 

[skpma]

Sorry for doubleposting...

If I remove the line below and also delete the header row, than it does almost what I want except it does not do it for the first month.

And Not Application.IsText(.Cells(i - 1, 1))

Anything I can do about this? (removing the header line is not an option unfortunately)

 

[JLGWhiz]

How about inserting a blank row under the header row as a quick fix. I thought that might be an issue but couldn't think of a way around it off hand. Maybe do the row insert in the code before it starts the For i loop? Then column A would fill on that row when the loop runs.

Sub ta()
Dim i As Long
With ActiveSheet
    Rows(2).Insert
    For i = .Cells(Rows.Count, 3).End(xlUp).Row To 2 Step -1
        If Month(.Cells(i, 3).Value) <> Month(.Cells(i - 1, 3).Value)  Then
            Rows(i).Insert
            .Cells(i, 1) = Format(.Cells(i + 1, 3).Value, "mmmm")
        End If
    Next
End With
End Sub

 

[skpma]

How about inserting a blank row under the header row as a quick fix. I thought that might be an issue but couldn't think of a way around it off hand. Maybe do the row insert in the code before it starts the For i loop? Then column A would fill on that row when the loop runs.

Thanks for your reply, but it stills throws an error.
It's probably not good coding but I got it working with the following:

Sub ta()
Dim i As Long
With ActiveSheet
    'Rows(2).Insert
    For i = .Cells(Rows.Count, 3).End(xlUp).Row To 2 Step -1
        On Error Resume Next
        If Month(.Cells(i, 3).Value) <> Month(.Cells(i - 1, 3).Value) Then
            Rows(i).Insert
            .Cells(i, 1) = Format(.Cells(i + 1, 3).Value, "mmmm")
        End If
    Next
End With
End Sub

I will go with this for now. Thanks for your help!

 

[JLGWhiz]

If It is producing what you want then the coding is OK.
Thanks for the feedbacfk,
regards, JLG