VBA Attempting to Insert New Rows but Only needing Column A copied

[horizonblue]

Hi,

Im using this VBA code at the moment.

Sub Macro1()
Dim i As Long, n As Variant
n = InputBox("How many rows:", "INSERT ROWS")
If n = "" Or Not IsNumeric Or n < 1 Then Exit Sub
If Int < Val Then Exit Sub
i = 10
Do While Cells(i, "B") <> ""
i = i + 1
Loop
Rows(i & ":" & i + n - 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Rows(i - 1 & ":" & i - 1).Copy
Rows(i & ":" & i + n - 1).PasteSpecial Paste:=xlPasteFormulas
Rows(i & ":" & i + n - 1).PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False
End Sub


The problem is, that it is copying everything in the previous rows. I am only wanting it to copy column A. Does anyone know how to fix this?

I'm also needing help to ensure that every time a new row is added that the reference number ticks over to the next numerical value.

 

[myall_blues]

Try this. You don't need to use a loop to find the last row.

Sub Macro1()
    Dim i As Long, n As Variant, lastRow As Long
    lastRow = Range("A" & Rows.Count).End(xlUp).Row
    n = InputBox("How many rows:", "INSERT ROWS")
    If n = "" Or Not IsNumeric(n) Or n < 1 Then Exit Sub
    If Int(n) < Val(n) Then Exit Sub
    Range("A" & lastRow + 1 & ":A" & lastRow + n).Formula = Range("A" & lastRow).Formula
    Range("A" & lastRow + 1 & ":A" & lastRow + n).NumberFormat = Range("A" & lastRow).NumberFormat
End Sub

 

[horizonblue]

Hi, thank you.

The code adds a new line, but doesn't push out the bottom row that needs to remain. In the image attached the black square needs to remain underneath every new row, like the line highlighted in yellow.

It also does not add the next numerical number in the reference number.

Thanks for your help.

 

[jolivanes]

What are the "Thumbs Down" representing? Is that part of your code or did it slip in there by accident?

I also can't find any question of what you want to achieve. You're showing code that does not work but no request.
It looks like you want to copy and paste. From where to where?
Anyway, let people know in a concise manner what you need to happen.

 

[myall_blues]

Try this then

Sub Macro1()
    Dim i As Long, n As Variant, lastRow As Long
    Dim refstr As String, refnum As Long, dashpos As Integer
    lastRow = Range("A" & Rows.Count).End(xlUp).Row
    n = InputBox("How many rows:", "INSERT ROWS")
    If n = "" Or Not IsNumeric(n) Or n < 1 Then Exit Sub
    If Int(n) < Val(n) Then Exit Sub
    Rows(lastRow + 1 & ":" & lastRow + n).Insert Shift:=xlDown
    refstr = Range("A" & lastRow).Value
    dashpos = InStr(1, refstr, "-")
    dashpos = InStr(dashpos + 1, refstr, "-")
    refnum = CLng(Mid(refstr, dashpos + 1))
    refstr = Left(refstr, dashpos)
    For i = 1 To n
        Range("A" & lastRow + i) = refstr & refnum
        refnum = refnum + 1
    Next i
End Sub

@jolivanes the thumbs are caused by the site interpreting (n) as a thumbs down emoji.

 

[jolivanes]

The pictures have different increase of values. One in the middle (VBA-028/24-25 to VBA-029/24-25) and the other at the end (VBA-027/24-25 to VBA-027/24-26)
Which is it?

Re: "the thumbs are caused by the site interpreting as a thumbs down emoji." New to me. Never seen that before. Thanks for the explanation.

 

[jolivanes]

This is the way I understand the request. If not, let us know.
To increase value in the middle

Sub Maybe_1()
Dim lr As Long, rws As Long, i As Long
lr = Cells(Rows.Count, 1).End(xlUp).Offset(1).Row
rws = Application.InputBox("How many rows to insert?", "Number required.", , , , , , 1)
Cells(lr, 1).Resize(rws).EntireRow.Insert Shift:=xlDown
    For i = lr To lr + rws - 1
        Cells(i, 1).Value = Left(Cells(i - 1, 1), 4) & Format(Mid(Cells(i - 1, 1), 5, 3) * 1 + 1, "000") & Mid(Cells(i - 1, 1), 8)
    Next i
End Sub

To increase value at the end

Sub Maybe_2()
Dim lr As Long, rws As Long, i As Long
lr = Cells(Rows.Count, 1).End(xlUp).Offset(1).Row
rws = Application.InputBox("How many rows to insert?", "Number required.", , , , , , 1)
Cells(lr, 1).Resize(rws).EntireRow.Insert Shift:=xlDown
    For i = lr To lr + rws - 1
        Cells(i, 1).Value = Left(Cells(i - 1, 1), 11) & Mid(Cells(i - 1, 1), 12) * 1 + 1
    Next i
End Sub

 

[horizonblue]

Try this then

Sub Macro1()
    Dim i As Long, n As Variant, lastRow As Long
    Dim refstr As String, refnum As Long, dashpos As Integer
    lastRow = Range("A" & Rows.Count).End(xlUp).Row
    n = InputBox("How many rows:", "INSERT ROWS")
    If n = "" Or Not IsNumeric(n) Or n < 1 Then Exit Sub
    If Int(n) < Val(n) Then Exit Sub
    Rows(lastRow + 1 & ":" & lastRow + n).Insert Shift:=xlDown
    refstr = Range("A" & lastRow).Value
    dashpos = InStr(1, refstr, "-")
    dashpos = InStr(dashpos + 1, refstr, "-")
    refnum = CLng(Mid(refstr, dashpos + 1))
    refstr = Left(refstr, dashpos)
    For i = 1 To n
        Range("A" & lastRow + i) = refstr & refnum
        refnum = refnum + 1
    Next i
End Sub

@jolivanes the thumbs are caused by the site interpreting (n) as a thumbs down emoji.

Thank you for your assistance. This code has worked great! Unfortunately the rows added looses the boarder around it.

 

[myall_blues]

That's fixable. Do you want borders like in your last picture?

 

[horizonblue]

That's fixable. Do you want borders like in your last picture?

Yes, thank you