VBA macro to insert multiple rows using input box

[Anthropologista]

I have a bit of a mess here. Still learning VBA, so rather than continuing to flounder, I decided to post my code thusfar.

By clicking a button on a different sheet, I need to find the cell in Col A of sheet “2018” with value “after last entry”. Upon finding that cell, I’d like to insert a number of rows (specified by user via input box) above it. Here is what I have:

Sub InsertRowsBox()
 
Dim endlist As Integer
Dim j As Long
Dim r As Range
 
myVal = "after last entry"
j = InputBox("Enter number of rows to be inserted:")
 
'Sheets("2018").Range("A3").Select
 
endlist = Sheets("2018").Cells(Rows.Count, "A").End(xlUp).Row
 
For Each Cell In Range("A3:A" & endlist)
 
    If Cell.Value = myVal Then
        If endlist = "" Then
        endlist = endlist & Cell.Row
        Else
        endlist = endlist & ", " & Cell.Row
        End If
    End If
Next Cell
 
r = Range(myVal)
Range(r.Offset(0, 0), r.Offset(j, 0)).EntireRow.Insert
 
End Sub

Thanks for your help and suggestions.

 

[JoeMo]

Does this do what you want?

Sub InsertRowsBox()
Dim j As Variant
Dim r As Range
myVal = "after last entry"
Application.ScreenUpdating = False
With Sheets("2018")
    Set r = .Range("A:A").Find(myVal, LookIn:=xlValues)
    If Not r Is Nothing Then
        j = InputBox("Enter number of rows to be inserted:")
        If j = "" Then Exit Sub
        r.Resize(j).EntireRow.Insert
    Else
        MsgBox "can't find myVal in column A"
    End If
End With
Application.ScreenUpdating = True
End Sub

 

[My Aswer Is This]

Try this:

Sub CheckMe()
'Modified 2-28-18 3:30 PM EST
Application.ScreenUpdating = False
Dim i As Long
Dim Lastrow As Long
Dim ans As Long
Lastrow = Sheets("2018").Cells(Rows.Count, "A").End(xlUp).Row
ans = InputBox("Insert How Many Rows?")
    For i = Lastrow To 1 Step -1
        If Sheets("2018").Cells(i, 1).Value = "after last entry" Then Sheets("2018").Rows(i).Offset(1).Resize(ans).Insert xlShiftDown
    Next
Application.ScreenUpdating = True
End Sub

 

[Anthropologista]

Does this do what you want?

Sub InsertRowsBox()
Dim j As Variant
Dim r As Range
myVal = "after last entry"
Application.ScreenUpdating = False
With Sheets("2018")
    Set r = .Range("A:A").Find(myVal, LookIn:=xlValues)
    If Not r Is Nothing Then
        j = InputBox("Enter number of rows to be inserted:")
        If j = "" Then Exit Sub
        r.Resize(j).EntireRow.Insert
    Else
        MsgBox "can't find myVal in column A"
    End If
End With
Application.ScreenUpdating = True
End Sub

Joe, Thank you for the quick solution! I've tested it several times and it works with flying colors. Many thanks!
Cheers,
Sarah

 

[JoeMo]

Joe, Thank you for the quick solution! I've tested it several times and it works with flying colors. Many thanks!
Cheers,
Sarah

You are welcome - thanks for the reply.

 

[Anthropologista]

Try this:

Sub CheckMe()
'Modified 2-28-18 3:30 PM EST
Application.ScreenUpdating = False
Dim i As Long
Dim Lastrow As Long
Dim ans As Long
Lastrow = Sheets("2018").Cells(Rows.Count, "A").End(xlUp).Row
ans = InputBox("Insert How Many Rows?")
    For i = Lastrow To 1 Step -1
        If Sheets("2018").Cells(i, 1).Value = "after last entry" Then Sheets("2018").Rows(i).Offset(1).Resize(ans).Insert xlShiftDown
    Next
Application.ScreenUpdating = True
End Sub

My Answer is This, Thank you for the quick response. I tested it but did not get the rows added where I need them. Joe's response will suffice, but I appreciate your help as well! Many thanks,
Sarah

 

[Anthropologista]

Joe,
Quick question for you re: code you helped me with a couple months ago. I have discovered that when I happen to have entire rows copied to my clipboard and I run the code you provided, the macro pastes the rows I intended to insert, along with the clipboard's current contents. Is this the intention of the command, and is the easiest solution to add a line in my code to clear the clipboard, e.g.

Dim j As Variant
Dim r As Range
myVal = "after last entry"
myVal2 = "FY total debits w/o ITTs"


Application.ScreenUpdating = False
Application.cutcopymode = false


With Sheets("2018")
    Set r = .Range("A:A").Find(myVal, LookIn:=xlValues)
    If Not r Is Nothing Then
        j = InputBox("Enter number of rows to be inserted:")
        If j = "" Then Exit Sub
        r.Resize(j).EntireRow.Insert
    Else
        MsgBox "Can't find last entry in column A"
    End If
End With

Many thanks,
Sarah

 

[JoeMo]

The code I posted originally should be altered like this:

Sub InsertRowsBox()
Dim j As Variant
Dim r As Range
myVal = "after last entry"
With Application
    .ScreenUpdating = False
    .CutCopyMode = False
End With
With Sheets("2018")
    Set r = .Range("A:A").Find(myVal, LookIn:=xlValues)
    If Not r Is Nothing Then
        j = InputBox("Enter number of rows to be inserted:")
        If j = "" Then Exit Sub
        r.Resize(j).EntireRow.Insert
    Else
        MsgBox "can't find myVal in column A"
    End If
End With
With Application
    .ScreenUpdating = True
    .CutCopyMode = True
End With
End Sub

 

[Anthropologista]

Thank you once again, Joe!

The code I posted originally should be altered like this:

Sub InsertRowsBox()
Dim j As Variant
Dim r As Range
myVal = "after last entry"
With Application
    .ScreenUpdating = False
    .CutCopyMode = False
End With
With Sheets("2018")
    Set r = .Range("A:A").Find(myVal, LookIn:=xlValues)
    If Not r Is Nothing Then
        j = InputBox("Enter number of rows to be inserted:")
        If j = "" Then Exit Sub
        r.Resize(j).EntireRow.Insert
    Else
        MsgBox "can't find myVal in column A"
    End If
End With
With Application
    .ScreenUpdating = True
    .CutCopyMode = True
End With
End Sub

 

[JoeMo]

You are welcome - thanks for the reply.