VBA Help - Insert Number values based on Input Box

[Johnny Thunder]

Hello All,

I am working on modifying an already working Macro and have no idea how to add in this additional piece of code.

Currently, the macro will Insert new rows based on how many rows the user inputs into an input box. I want to add a small piece of code that will also insert a Number in column D for each newly created blank row.

For example, if the user chooses to enter 3 new Rows, the first blank row that is inserted will have a "'01", the following row "'02" and so on. I add the Quotes because in Excel if you were to enter 01, it will be converted to just appear as "1".

the purpose of the code of the original code is to not have the users copy all the formatting and dropdowns from other rows manually, so the code will find a hidden row that contains all my formatting and dropdowns, unhide it, copy it, and insert rows above it to retain all the formats.

here is my current code:

'------------------------------------------------------------------------------------------
'--- 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, "A").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("A" & LastR + 1 & "").EntireRow.Hidden = False

Set lastRowRange = ws1.Range(LastR + 1 & ":" & LastR + 1)

            ws1.Range(lastRowRange, lastRowRange.Offset(CInt(stRows) - 1, 0)).EntireRow.Insert
                
LastR2 = ws1.Cells(Rows.Count, "A").End(xlUp).Row   ' New Lastr
Set lastRowRange2 = Range(LastR2 & ":" & LastR2)
            
            Range(lastRowRange2, lastRowRange2).Copy
            Range(lastRowRange2.Offset(-CInt(stRows), 0), lastRowRange2).PasteSpecial
            Application.CutCopyMode = False
  
  ws1.Range("A" & LastR2 & "").EntireRow.Hidden = True
               
Application.ScreenUpdating = True
  
End Sub

 

[Fluff]

How about

   Application.ScreenUpdating = False
   
   ws1.Range("A" & LastR + 1 & "").EntireRow.Hidden = False
   
   ws1.Rows(LastR + 1).Resize(stRows).Insert
   ws1.Rows(LastR + 1).Resize(stRows + 1).FillUp
   With ws1.Range("D" & LastR + 1)
      .Resize(stRows).NumberFormat = "@"
      .Value = "01"
      If stRows > 1 Then .AutoFill .Resize(stRows), xlFillSeries
   End With
   ws1.Rows(LastR).Offset(stRows + 1).EntireRow.Hidden = True
                  
   Application.ScreenUpdating = True

 

[Johnny Thunder]

Hey @Fluff Sorry I never got around to responding but this worked like a charm! Thanks again for all the amazing gems over the years.

 

[Fluff]

You're welcome & thanks for the feedback.