Insert blank row in every given group number of row based in month - VBA

SilentRomance

New Member
Joined
Aug 4, 2021
Messages
46
Office Version
  1. 2016
  2. 2010
Platform
  1. Windows
Hello guys
Here's my problem
I'm trying to insert blank row in my data sheet in every group number given (ex. after 5 or 10 rows) based on month.
It will add and add blank row until the end of a month (ex. September) and if there is another month (ex. October) it will start counting based on group number given (ex. after 5 or 10 rows) and insert blank row until the end of that month (October).

Example, this the data:
GF - Lagawe.xlsm
A
108-Sep-21
209-Sep-21
310-Sep-21
411-Sep-21
512-Sep-21
613-Sep-21
714-Sep-21
815-Sep-21
916-Sep-21
1017-Sep-21
1118-Sep-21
1219-Sep-21
1320-Sep-21
1401-Oct-21
1502-Oct-21
1603-Oct-21
1704-Oct-21
1805-Oct-21
1906-Oct-21
2007-Oct-21
2108-Oct-21
2209-Oct-21
2310-Oct-21
2411-Oct-21
2512-Oct-21
2603-Nov-21
2704-Nov-21
2805-Nov-21
2906-Nov-21
3007-Nov-21
3108-Nov-21
3209-Nov-21
3310-Nov-21
3411-Nov-21
3512-Nov-21
3613-Nov-21
3714-Nov-21
3815-Nov-21
3916-Nov-21
4017-Nov-21
Sheet1


If run a code I want to be like this:

GF - Lagawe.xlsm
A
108-Sep-21
209-Sep-21
310-Sep-21
411-Sep-21
512-Sep-21
6
713-Sep-21
814-Sep-21
915-Sep-21
1016-Sep-21
1117-Sep-21
12
1318-Sep-21
1419-Sep-21
1520-Sep-21
16
1701-Oct-21
1802-Oct-21
1903-Oct-21
2004-Oct-21
2105-Oct-21
22
2306-Oct-21
2407-Oct-21
2508-Oct-21
2609-Oct-21
2710-Oct-21
28
2911-Oct-21
3012-Oct-21
31
3203-Nov-21
3304-Nov-21
3405-Nov-21
3506-Nov-21
3607-Nov-21
37
3808-Nov-21
3909-Nov-21
4010-Nov-21
4111-Nov-21
4212-Nov-21
43
4413-Nov-21
4514-Nov-21
4615-Nov-21
4716-Nov-21
4817-Nov-21
Sheet1


Can you help me guys. Thanks!
 

Excel Facts

Pivot Table Drill Down
Double-click any number in a pivot table to create a new report showing all detail rows that make up that number
Give this a try with a copy of your workbook

VBA Code:
Sub Insert_Rows()
  Dim a As Variant
  Dim i As Long, k As Long, xtra As Long
  
  Const NumRows As Long = 5
  
  a = Range("A1", Range("A" & Rows.Count).End(xlUp)).Value
  Application.ScreenUpdating = False
  For i = 2 To UBound(a)
    If Month(a(i, 1)) <> Month(a(i - 1, 1)) Or k = NumRows - 1 Then
      Rows(i + xtra).Insert
      xtra = xtra + 1
      k = 0
    Else
      k = k + 1
    End If
  Next i
  Application.ScreenUpdating = True
End Sub
 
Upvote 0
Solution
Hi SilenceRomance,

Though Peter has beaten me to the punch and I would actually use his solution, here is mine proposed solution nonetheless:

VBA Code:
Option Explicit
Sub Macro1()

    Dim lngBlock As Long, i As Long
    Dim lngMyRow As Long, lngLastRow As Long
    Dim strSrcCol As String
    Dim ws As Worksheet
    Dim rngRowInsert As Range
    
    Application.ScreenUpdating = False
    
    lngBlock = 5 'Number of days in a month before inserting a blank row. Change to suit if necessary.
    Set ws = ThisWorkbook.Sheets("Sheet1") 'Name of sheet with dates. Change to suit if necessary.
    strSrcCol = "A" 'Column containing the dates in 'ws'. Change to suit if necessary.
    lngLastRow = ws.Cells(Rows.Count, strSrcCol).End(xlUp).Row
    
    For lngMyRow = 1 To lngLastRow
        If DateDiff("m", ws.Range(strSrcCol & lngMyRow), Range(strSrcCol & lngMyRow + 1)) > 0 Then
            If rngRowInsert Is Nothing Then
                Set rngRowInsert = ws.Range("A" & lngMyRow + 1)
            Else
                Set rngRowInsert = Union(rngRowInsert, ws.Range("A" & lngMyRow + 1))
            End If
            i = 0
        Else
            i = i + 1
            If i = lngBlock Then
                If rngRowInsert Is Nothing Then
                    Set rngRowInsert = ws.Range("A" & lngMyRow + 1)
                Else
                    Set rngRowInsert = Union(rngRowInsert, ws.Range("A" & lngMyRow + 1))
                End If
                i = 0
            End If
        End If
    Next lngMyRow
    
    If Not rngRowInsert Is Nothing Then
        rngRowInsert.Insert Shift:=xlDown
    End If
    
    Application.ScreenUpdating = True

End Sub

Regards,

Robert
 
Upvote 0
Give this a try with a copy of your workbook

VBA Code:
Sub Insert_Rows()
  Dim a As Variant
  Dim i As Long, k As Long, xtra As Long
 
  Const NumRows As Long = 5
 
  a = Range("A1", Range("A" & Rows.Count).End(xlUp)).Value
  Application.ScreenUpdating = False
  For i = 2 To UBound(a)
    If Month(a(i, 1)) <> Month(a(i - 1, 1)) Or k = NumRows - 1 Then
      Rows(i + xtra).Insert
      xtra = xtra + 1
      k = 0
    Else
      k = k + 1
    End If
  Next i
  Application.ScreenUpdating = True
End Sub
Thank you very much bro!
 
Upvote 0
Hi SilenceRomance,

Though Peter has beaten me to the punch and I would actually use his solution, here is mine proposed solution nonetheless:

VBA Code:
Option Explicit
Sub Macro1()

    Dim lngBlock As Long, i As Long
    Dim lngMyRow As Long, lngLastRow As Long
    Dim strSrcCol As String
    Dim ws As Worksheet
    Dim rngRowInsert As Range
   
    Application.ScreenUpdating = False
   
    lngBlock = 5 'Number of days in a month before inserting a blank row. Change to suit if necessary.
    Set ws = ThisWorkbook.Sheets("Sheet1") 'Name of sheet with dates. Change to suit if necessary.
    strSrcCol = "A" 'Column containing the dates in 'ws'. Change to suit if necessary.
    lngLastRow = ws.Cells(Rows.Count, strSrcCol).End(xlUp).Row
   
    For lngMyRow = 1 To lngLastRow
        If DateDiff("m", ws.Range(strSrcCol & lngMyRow), Range(strSrcCol & lngMyRow + 1)) > 0 Then
            If rngRowInsert Is Nothing Then
                Set rngRowInsert = ws.Range("A" & lngMyRow + 1)
            Else
                Set rngRowInsert = Union(rngRowInsert, ws.Range("A" & lngMyRow + 1))
            End If
            i = 0
        Else
            i = i + 1
            If i = lngBlock Then
                If rngRowInsert Is Nothing Then
                    Set rngRowInsert = ws.Range("A" & lngMyRow + 1)
                Else
                    Set rngRowInsert = Union(rngRowInsert, ws.Range("A" & lngMyRow + 1))
                End If
                i = 0
            End If
        End If
    Next lngMyRow
   
    If Not rngRowInsert Is Nothing Then
        rngRowInsert.Insert Shift:=xlDown
    End If
   
    Application.ScreenUpdating = True

End Sub

Regards,

Robert
Thanks bro! It work also
 
Upvote 0
You're welcome. Glad we could help. Thanks for the follow-up. :)
 
Upvote 0

Forum statistics

Threads
1,213,536
Messages
6,114,211
Members
448,554
Latest member
Gleisner2

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