VBA Help - Add Rows Feature but to the Top of table

[Johnny Thunder]

Hello All,

I had a script that was working great until the team I support asked for a new request and not sure how to modify my current script to accommodate. Currently, my script is triggered by a macro button and asks the user how many rows they would like to add. I have a hidden helper row that is blank but contains all my formatting and formulas in it so when adding in new rows they contain all of this.

With this new request they would like to have the new rows added at the top of the data table. Is it possible to do this easily and can you use the filled in row beneath the newly added rows to copy all the formats and formulas without bringing in the values?

If so, how would my current code be modified? Any help is appreciated.

My data starts at (D4:V4) and can go down as many rows as the user has entered so LastRow is always changing. Also, There are Macro buttons in Columns B1:B7 so I can't do an Insert rows across the whole sheet, it needs to be Inserted between Columns D:V only.

'------------------------------------------------------------------------------------------
'--- Adds Rows to Input Tab while preserving Formulas and formats
'-------------------------------------------------------------------------------------------
Sub AddRows1()

Dim ws1         As Worksheet
Dim LastR      As Long, LastR2 As Long
Dim Cell        As Range, lastRowRange As Range, lastRowRange2 As Range, LastRow As Integer, Foundrow As Range, i As Integer
Dim stRows   As String, StartRow As String, BlockName As String, BlockVariable As String

Set ws1 = ActiveSheet

LastR = ws1.Cells(Rows.Count, "D").End(xlUp).Row

StartRow = LastR

Start:
            stRows = InputBox("Number of Rows to insert?", "How Many Rows in Your Title?")
            If stRows = "" Then Exit Sub
            If Not IsNumeric(stRows) Then
                MsgBox "Please enter a numeric value!", vbCritical, "Not a numeric value"
                GoTo Start
            End If

 Application.ScreenUpdating = False
   
   ws1.Range("D" & LastR + 1 & "").EntireRow.Hidden = False
   
        ws1.Rows(LastR + 1).Resize(stRows).Insert   'Drops in new blank rows
            ws1.Rows(LastR + 1).Resize(stRows + 1).FillUp   'Repeats all formulas in new blank rows
        
        With ws1.Range("D" & LastR + 1) 'Formats the newly added rows and fills in series
            .Resize(stRows).NumberFormat = "@"
            .Value = ws1.Range("D" & LastR + 1).Value
             If stRows > 1 Then .AutoFill .Resize(stRows), xlFillSeries
        End With
        
        ws1.Rows(LastR).Offset(stRows + 1).EntireRow.Hidden = True 'Rehides Lastrow
                  
   Application.ScreenUpdating = True
   
End Sub

 

[Crystalyzer]

If you convert your range to a table you can try this

'------------------------------------------------------------------------------------------
'--- Adds Rows to Input Tab while preserving Formulas and formats
'-------------------------------------------------------------------------------------------
Sub AddRows1()

Dim ws1 As Worksheet
Dim i As Integer
Dim stRows As String

Set ws1 = ActiveSheet

Start:
     stRows = InputBox("Number of Rows to insert?", "How Many Rows in Your Title?")
     If stRows = "" Then Exit Sub
     If Not IsNumeric(stRows) Then
          MsgBox "Please enter a numeric value!", vbCritical, "Not a numeric value"
          GoTo Start
     End If

     Application.ScreenUpdating = False
     Range("D4:V4").Select
     For i = 1 To stRows
          Selection.ListObject.ListRows.Add (i)
     Next
   
     ws1.Range("D" & 4 + stRows & ":V" & 4 + stRows).Copy
     Range("D4:V" & 4 + stRows - 1).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
          SkipBlanks:=False, Transpose:=False
     Application.CutCopyMode = False
     Application.ScreenUpdating = True
 
End Sub

 

[Johnny Thunder]

I need to keep the range as a regular data range and not a table. I have 15 other macros that rely on the data staying this way. Is there a way to modify?