excelvbaexcel-2021

Dynamically Inserting a row and iterating over it in VBA?


During reverse iteration of a range of cells (down to up going right to left), a row is inserted above the current one and and shifts down.

Sub ReverseIterateAndInsertRowRestart()
    Dim ws As Worksheet
    Dim rng As Range
    Dim r As Long, c As Long
    Dim columnToCheck As Long
    Dim startRow As Long, startColumn As Long

    ' Set the worksheet and define the initial range
    Set ws = ActiveSheet
    Set rng = ws.Range("A1:E10") ' Adjust as needed

    ' Initialize starting row and column
    startRow = rng.Rows.Count
    startColumn = rng.Columns.Count

    ' Iterate through each row from bottom to top
    For r = startRow To 1 Step -1
        ' Iterate through each column from right to left
        For c = startColumn To 1 Step -1
            ' Check if the cell is blank
            If Not IsEmpty(rng.Cells(r, c)) Then
                ' Insert a copy of the current row above
                rng.Rows(r).Copy
                rng.Rows(r).Insert Shift:=xlDown
                rng.Cells(r, c).ClearContents ' Clear the specific cell in the copied row

                ' Update the range to include the new row
                Set rng = ws.Range(rng.Cells(1, 1), rng.Cells(rng.Rows.Count, rng.Columns.Count))

                ' Adjust the row counter to account for the new row
                r = r + 1
            End If
        Next c
    Next r
End Sub

How would one ensure the iteration continues to the newly created row (as though it were already there)? Tried adding r=r+1 with no luck. Can't seem to update the loop.


Solution

  • A big thank you to @Ken White. Indeed to backdown rows, one has to monkey with the loop. Please see the following paragraph. Also a big thank you to @rotabor for his variants. His theorems pass the test but fail in practice. They don't take into account variadic rows (having different number of columns) and mixed. However, I would kindly ask that he doesn't delete them, because they are valuable learning materials. They have been immensely helpful. I will also state the same for the comments (all of them).

    Because we are iterating backwards and inserting rows above the current row, we also have to push the limit (0) backwards to account for the added rows.

    So here is a real-world use-case solution (simplified).

    Option Explicit ' Force explicit variable declaration. 
    
    Sub ReverseIterateAndInsertRowRestart()
        ' Firstly, sort the fields if rows have mixed data to avoid duplicates.
        ' Use a procedure that looks good to you here: https://stackoverflow.com/questions/79082783.
          Call SortBlanksOnTop
          
        ' Set up your variables and turn off screen updating.
          Dim t As String
          Dim a As Long, b As Long, c As Long, d As Long, e As Long
          Dim r As Range ' Working range
          Dim Cell As Range, Left As Range, LeftTop As Range
          Dim insert As Boolean
          Application.ScreenUpdating = False
        
        ' Set title for the range selection user dialog box.
          t = "Selection Range"
        
        ' Request and store range from user.
          Set r = Application.InputBox("Range", t, Application.Selection.Address, Type:=8)
          
        ' Initialize.
          a = 0
          b = r.Rows.Count
          
        ' Iterate through each row from bottom to top.
          Do While b > a
            ' Assume no row has been added
              insert = False
            
            ' Iterate through each column from right to left within that row
              For c = r.Columns.Count To 1 Step -1
                  Set Cell = r.Cells(b, c)
    
                ' Calculate the relative column number within the range
                  d = Cell.Column - r.Columns(1).Column + 1
                
                ' This condition is based on the example data and layout provided below. Please adjust to your needs.
                ' Skip formular cells and only proceed if there are 2 additional columns to the left of the selected range.
                  If Not IsEmpty(Cell) And Not Cell.HasFormula And d > 2 Then
                      Set Left = Cell.Offset(0, -2)
                      
                    ' If row above exists, compare values
                      If Cell.Row > 1 Then
                          Set LeftTop = Left.Offset(-1, 0)
                          If Left.Value <> LeftTop.Value Then
                        ' Indicate that a row has been added
                            insert = True
                          End If
                      Else
                        ' Indicate that a row has been added
                          insert = True
                      End If
                      
                      If insert Then
                        ' Copy the current row
                          r.Rows(b).EntireRow.Copy
                          
                        ' Insert the copied row above the current row
                          r.Rows(b).EntireRow.insert Shift:=xlDown
                        
                        ' Clear the contents of the current column in the newly inserted row
                          Cell.Offset(-1, 0).ClearContents
    
                        ' Calculate the relative row number within the range
                          e = Cell.Row - r.Rows(1).Row + 1
                          
                        ' Adjust the row counter
                          If e > 1 Then b = b + 1
        
                        ' Restart loop for next row
                          Exit For
                      Else
                        ' Exit current row
                          Exit For
                      End If
                  End If
              Next c
            ' Count down
              b = b - 1
              
            ' If a row was added, adjust the row limit to account for the new row
              If insert And b <= 0 Then a = b - 1
          Loop
          
        ' Turn screen updating back on.
          Application.ScreenUpdating = True
    End Sub
    

    You may add your conditions as necessary to the IF clause.

    Example data (Uses a formula for the numbers)

    ![enter image description here

    Result

    enter image description here