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.

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
    Range("A" & lastRow & ":G" & lastRow).Copy
    Range("A" & lastRow + 1 & ":G" & lastRow + n).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Range("A11:G13").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    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

 

[horizonblue]

Try this.

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
    Range("A" & lastRow & ":G" & lastRow).Copy
    Range("A" & lastRow + 1 & ":G" & lastRow + n).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Range("A11:G13").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    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

Hi, thank you, that worked great. I just noticed I made a mistake, and I actually need the number next to VBA to increase in numerical order. I need the 24-25 to remain as that's displaying the financial year. I've popped in an image of what I am wanting.

 

[jolivanes]

One thing you have to make sure of. Don't try the suggestions in Post #7, or even acknowledge that they are there.

 

[horizonblue]

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

Thanks for the suggestion, I appreciate it.

 

[horizonblue]

One thing you have to make sure of. Don't try the suggestions in Post #7, or even acknowledge that they are there.

Thanks for your message, I did try your suggestion on the day you posted it. However, I did receive an error on the code unfortunately. I appreciate the suggestion.

 

[jolivanes]

I must have missed the post where you mentioned that you tried it and what the error was. Sorry about that.

 

[jolivanes]

For people that end up at this thread, hoping to find a solution for a similar or same problem, could you be so kind and let us know what error it throws and on which line.
I have tried it several times on a test workbook and it works like a charm on it.

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)
If rws < 1 Then Exit Sub
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
    With Cells(lr, 1).Resize(rws, 7).Borders
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .Weight = xlThin
    End With
End Sub

 

[myall_blues]

Updated code.. Apologies also there was a mistake in my last one - I forgot to remove a couple of testing lines.

Sub Macro1()
    Dim i As Long, n As Variant, lastRow As Long
    Dim refstr As String
    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
    Range("A" & lastRow & ":G" & lastRow).Copy
    Range("A" & lastRow + 1 & ":G" & lastRow + n).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    refstr = Range("A" & lastRow).Value
    For i = 1 To n
        Range("A" & lastRow + i) = _
            Left(refstr, 4) & Format(Val(Mid(refstr, 5, 3)) + i, "000") & Mid(refstr, 8)
    Next i
End Sub

 

[horizonblue]

For people that end up at this thread, hoping to find a solution for a similar or same problem, could you be so kind and let us know what error it throws and on which line.
I have tried it several times on a test workbook and it works like a charm on it.

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)
If rws < 1 Then Exit Sub
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
    With Cells(lr, 1).Resize(rws, 7).Borders
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .Weight = xlThin
    End With
End Sub

This unfortunately gives me a run time error '13' - type mismatch

 

[jolivanes]

You forgot to mention which line caused the error.