VBA - How to insert Row in every last day of the months?

SilentRomance

New Member
Joined
Aug 4, 2021
Messages
46
Office Version
  1. 2016
  2. 2010
Platform
  1. Windows
I want to insert new row/s between months as shown in the pictures below
1628840791832.png


1628841189110.png


How do i do this with VBA codes guys?
 

Excel Facts

Waterfall charts in Excel?
Office 365 customers have access to Waterfall charts since late 2016. They were added to Excel 2019.
I am not actually a big fan of doing this, it looks like you have it in a database format which is ideal for analysis eg pivot tables, filtering etc.
Are you sure you can't use a pivot table to do what you are trying to do ?

Be that as it may, try this code:
I have hard coded the starting cell as being A3,
please change this to what your real starting cell is.

Also if you were intending to use merged cells in the inserted lines, that is generally considered a really bad idea, so in the code I have centered across selection (columns A:D)

VBA Code:
Sub InsertRowEOM()

    Dim lastRow As Long
    Dim firstRow As Long
    Dim iRow As Long
    Dim ws As Worksheet
    
    Set ws = ActiveSheet
    
    firstRow = ws.Range("A3").Row
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    For iRow = lastRow To firstRow Step -1
    
        If ws.Cells(iRow, "A") = DateSerial(Year(ws.Cells(iRow, "A")), Month(ws.Cells(iRow, "A")) + 1, 0) Then
            ws.Cells(iRow + 1, "A").EntireRow.Insert
            With ws.Cells(iRow + 1, "A")
                .Value = "This is the record of all purchase of the month of " & Format(ws.Cells(iRow, "A"), "mmm")
                .Resize(, 4).HorizontalAlignment = xlCenterAcrossSelection
                .Resize(, 4).WrapText = True
            End With
        
        End If
           
    Next iRow

End Sub
 
Upvote 0
I am not actually a big fan of doing this, it looks like you have it in a database format which is ideal for analysis eg pivot tables, filtering etc.
Are you sure you can't use a pivot table to do what you are trying to do ?

Be that as it may, try this code:
I have hard coded the starting cell as being A3,
please change this to what your real starting cell is.

Also if you were intending to use merged cells in the inserted lines, that is generally considered a really bad idea, so in the code I have centered across selection (columns A:D)

VBA Code:
Sub InsertRowEOM()

    Dim lastRow As Long
    Dim firstRow As Long
    Dim iRow As Long
    Dim ws As Worksheet
   
    Set ws = ActiveSheet
   
    firstRow = ws.Range("A3").Row
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
   
    For iRow = lastRow To firstRow Step -1
   
        If ws.Cells(iRow, "A") = DateSerial(Year(ws.Cells(iRow, "A")), Month(ws.Cells(iRow, "A")) + 1, 0) Then
            ws.Cells(iRow + 1, "A").EntireRow.Insert
            With ws.Cells(iRow + 1, "A")
                .Value = "This is the record of all purchase of the month of " & Format(ws.Cells(iRow, "A"), "mmm")
                .Resize(, 4).HorizontalAlignment = xlCenterAcrossSelection
                .Resize(, 4).WrapText = True
            End With
       
        End If
          
    Next iRow

End Sub
Hi Alex Blakenburg
I apply your code and this is the result
1629083905077.png


My desired output would be like this

1629084175817.png


Even if there is the same last day of the month (31 or 30), only one row will be inserted
And even if it is not the last day of the month (1-29 or 1-30), it will also add a row.
 
Upvote 0
Give this macro a try (set the start row for your dates in the StartRow constant)...
VBA Code:
Sub SeparateRecords()
  Dim R As Long, LastRow As Long
  Const StartRow As Long = 2
  LastRow = Cells(Rows.Count, "A").End(xlUp).Row
  Application.ScreenUpdating = False
  Cells(LastRow + 1, "A").Value = "This is the record of all purchase of the month of " & MonthName(Month(Cells(LastRow, "A")))
  For R = LastRow To StartRow + 1 Step -1
    If Month(Cells(R, "A")) <> Month(Cells(R - 1, "A")) Then
      Rows(R).Insert
      Cells(R, "A").Value = "This is the record of all purchase of the month of " & MonthName(Month(Cells(R - 1, "A")))
    End If
  Next
  Application.ScreenUpdating = True
End Sub
 
Upvote 0
Solution
Give this macro a try (set the start row for your dates in the StartRow constant)...
VBA Code:
Sub SeparateRecords()
  Dim R As Long, LastRow As Long
  Const StartRow As Long = 2
  LastRow = Cells(Rows.Count, "A").End(xlUp).Row
  Application.ScreenUpdating = False
  Cells(LastRow + 1, "A").Value = "This is the record of all purchase of the month of " & MonthName(Month(Cells(LastRow, "A")))
  For R = LastRow To StartRow + 1 Step -1
    If Month(Cells(R, "A")) <> Month(Cells(R - 1, "A")) Then
      Rows(R).Insert
      Cells(R, "A").Value = "This is the record of all purchase of the month of " & MonthName(Month(Cells(R - 1, "A")))
    End If
  Next
  Application.ScreenUpdating = True
End Sub
Thank you very much sir!
 
Upvote 0

Forum statistics

Threads
1,213,527
Messages
6,114,140
Members
448,551
Latest member
Sienna de Souza

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top