Insert "one" blank row every "variable" number of rows - including LOOP? - vba

Question

can anyone advise how can I turn RowIncrement = 2 into a "loop" that goes and pick ups the values from a column based on the other sheet? So, if the first value in the column is 1 then RowIncrement = 1, then it goes to the next value in that column, which may be e.g. 6 and then RowIncrement = 6 and so on.
Sub EmptyRowEveryX()
Dim NumRowsToInsert As Long
Dim RowIncrement As Long
Dim ws As Excel.Worksheet
Dim LastRow As Long
Dim LastEvenlyDivisibleRow
Dim i As Long
Dim z As Long
Dim HowMany As Integer
NumRowsToInsert = 1
RowIncrement = 2
Set ws = ActiveSheet
For n = LastRow To 1 Step -1
HowMany = Range("BM" & z)
If (HowMany > 1) Then
Rows(z & ":" & HowMany).Insert Shift:=xlDown
End If
With ws
LastRow = .Range("AZ" & .Rows.count).End(xlUp).Row
LastEvenlyDivisibleRow = Int(LastRow / RowIncrement) * RowIncrement
If LastEvenlyDivisibleRow = 0 Then
Exit Sub
End If
For i = LastEvenlyDivisibleRow To 1 Step -RowIncrement
.Range(i & ":" & i + (NumRowsToInsert - 1)).Insert xlShiftDown
Next i
End With
Application.ScreenUpdating = True
End Sub

Answer 1

Sub OneEmptyRow()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
With Range("AZ1", Range("AZ" & Rows.count).End(xlUp))
.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(1), _
Replace:=True, PageBreaks:=False, SummaryBelowData:=True
.Offset(, -1).AutoFilter Field:=1, Criteria1:="=*total*"
.Offset(2).SpecialCells(xlCellTypeVisible).ClearContents
.AutoFilter
.Offset(, -1).EntireColumn.Delete
.EntireColumn.RemoveSubtotal
End With
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub