VBA Help - Insert Number values based on Input Box

Johnny Thunder

Well-known Member
Joined
Apr 9, 2010
Messages
681
Office Version
  1. 2016
Platform
  1. MacOS
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:

VBA 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
 

Excel Facts

Spell Check in Excel
Press F7 to start spell check in Excel. Be careful, by default, Excel does not check Capitalized Werds (whoops)

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
73,211
Office Version
  1. 365
Platform
  1. Windows
How about
VBA Code:
   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

Well-known Member
Joined
Apr 9, 2010
Messages
681
Office Version
  1. 2016
Platform
  1. MacOS
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

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
73,211
Office Version
  1. 365
Platform
  1. Windows
You're welcome & thanks for the feedback.
 
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,164,012
Messages
5,834,909
Members
430,326
Latest member
tomwax46

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top