VBA Help - Insert Number values based on Input Box

Johnny Thunder

Well-known Member
Joined
Apr 9, 2010
Messages
677
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
 

Some videos you may like

Excel Facts

Select all contiguous cells
Pressing Ctrl+* (asterisk) will select the "current region" - all contiguous cells in all directions.

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
55,301
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
677
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
55,301
Office Version
  1. 365
Platform
  1. Windows
You're welcome & thanks for the feedback.
 

Watch MrExcel Video

Forum statistics

Threads
1,127,107
Messages
5,622,777
Members
415,927
Latest member
vedasinternational

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