CODEWITHSUNDEEP
excelvba
MikeF
MikeF

Reputation: 19

Add Rows based on user input in Column/ Cell Value and Copy Formulas Down

I'm trying to add rows below every time a cell within a specific column, based on user input in Application.InputBox, has a value "Start".
The worksheet may have multiple instances of "Start" in the same column so I need multiple rows created below the "start" row.
I also need the formulas from the row where "Start" appears to copy down into the rows just created.

Code 1 asks for user input for the column where the value "Start" is but only adds one new row and does not copy the formulas down.
Code 2 asks for user input for the # of rows and row to start, it does not look for the column value I need for reference and won't copy the formulas down.
Both codes work but is there a way to add to code 1 or combine these into one and add the "copy formulas" portion?

I click a button to start the code.
The quantity and location of "Start" is dynamic but always within the same column.
Worksheet names are never the same.
The width of data/formulas in each row is dynamic.

Code 1

    Dim Rng As Range
    Dim WorkRng As Range
    On Error Resume Next
   
    xTitleId = "Enter the value"
    Set WorkRng = Application.Selection
    Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
    Set WorkRng = WorkRng.Columns(1)
    xLastRow = WorkRng.Rows.Count
    Application.ScreenUpdating = False
    For xRowIndex = xLastRow To 1 Step -1
        Set Rng = WorkRng.Range("A" & xRowIndex)
        If Rng.Value = "Start" Then
            Rng.Offset(1, 0).EntireRow.Insert Shift:=xlDown
        End If
    Next
    Application.ScreenUpdating = True
End Sub

Code 2

Dim iRow As Long
Dim iCount As Long
Dim i As Long
On Error Resume Next

iCount = Application.InputBox(Prompt:="How many rows you want to add?")
iRow = Application.InputBox _
  (Prompt:="After which row you want to add new rows? (Enter the row number")

For i = 1 To iCount
    Rows(iRow).EntireRow.Insert  
Next i

End Sub

Upvotes: 1

Views: 328

Answers (1)

taller
taller

Reputation: 18778

  • Validating user input is essential to ensure the robustness of the code.
  • Use FillDown to apply formulas on inserted rows

Microsoft documentation:

Range.FillDown method (Excel)

Option Explicit

Sub InsertRows()
    Dim Rng As Range, xTitleId As String
    Dim WorkRng As Range, xLastRow As Long, xRowIndex As Long
    Dim iRow, iCount
    Dim i As Long
    xTitleId = "Enter the value"
    iCount = Application.InputBox(Title:=xTitleId, Prompt:="How many rows you want to add?")
    If (Not IsNumeric(iCount)) Or Val(iCount) < 1 Then
        MsgBox "The input is not a valid number"
        Exit Sub
    End If
    iRow = Application.InputBox(Title:=xTitleId, Prompt:="After which row you want to add new rows? (Enter the row number)")
    If (Not IsNumeric(iRow)) Or Val(iRow) < 1 Then
        MsgBox "The input is not a valid number"
        Exit Sub
    End If
    Set WorkRng = Selection
    Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
    Dim formulaRng As Range
    Set formulaRng = WorkRng.Resize(1, WorkRng.Columns.Count - 1).Offset(, 1).EntireColumn
    Set WorkRng = WorkRng.Columns(1)
    xLastRow = WorkRng.Rows.Count
    Application.ScreenUpdating = False
    For xRowIndex = xLastRow To 1 Step -1
        Set Rng = WorkRng.Range("A" & xRowIndex)
        If Rng.Row > iRow Then
            If Rng.Value = "Start" Then
                Rng.Offset(1, 0).Resize(iCount).EntireRow.Insert
                Intersect(Rng.Resize(iCount + 1).EntireRow, formulaRng).FillDown
            End If
        End If
    Next
    Application.ScreenUpdating = True
End Sub

Testing Input:

How many rows you want to add: 2
After which row you want to add new rows: 4
Selecct Range: $A$2:$B$14

enter image description here

Update2:

  • Assuming Start is on the first col of the table.
  • Add code to remove Start on the inserted rows
Option Explicit

Sub InsertRows2()
    Dim Rng As Range, xTitleId As String
    Dim WorkRng As Range, xLastRow As Long, xRowIndex As Long
    Dim iRow, iCount, i As Long
    Const COL_INDEX = 2
    xTitleId = "Enter the value"
    iCount = Application.InputBox(Title:=xTitleId, Prompt:="How many rows you want to add?")
    If (Not IsNumeric(iCount)) Or Val(iCount) < 1 Then
        MsgBox "The input is not a valid number"
        Exit Sub
    End If
    iRow = Application.InputBox(Title:=xTitleId, Prompt:="After which row you want to add new rows? (Enter the row number)")
    If (Not IsNumeric(iRow)) Or Val(iRow) < 1 Then
        MsgBox "The input is not a valid number"
        Exit Sub
    End If
    Set WorkRng = ActiveSheet.UsedRange
    Dim formulaRng As Range
    If WorkRng.Columns.Count > 1 Then _
        Set formulaRng = WorkRng.Resize(1, WorkRng.Columns.Count - 1).Offset(, 1).EntireColumn
    Set WorkRng = WorkRng.Columns(COL_INDEX)
    xLastRow = WorkRng.Rows.Count
    Application.ScreenUpdating = False
    For xRowIndex = xLastRow To 1 Step -1
        Set Rng = WorkRng.Range("A" & xRowIndex)
        If Rng.Row > iRow Then
            If Rng.Value = "Start" Then
                Rng.Offset(1, 0).Resize(iCount).EntireRow.Insert
                If Not formulaRng Is Nothing Then
                    Intersect(Rng.Resize(iCount + 1).EntireRow, formulaRng).FillDown
                    Rng.Offset(1, 0).Resize(iCount).ClearContents
                End If
            End If
        End If
    Next
    Application.ScreenUpdating = True
End Sub

Upvotes: 1

Related Questions