Loop Question

[Sundae]

Hi, I have the following code:

Sub Copy_Rows()
Dim nextrow As Long, i As Long

Application.ScreenUpdating = False

With Worksheets("Baby")


For i = 1 To WorksheetFunction.COUNTIF(Workbooks("Data.xlsx").Worksheets("Sheet1").Columns("A"), Range("BALL")) - 1

Range("RUTH").Copy

Range("Total").Insert Shift:=xlDown

nextrow = .Cells(Rows.Count, "A").End(xlUp).Row

Range("A" & nextrow + 1).PasteSpecial

Next i
End With

Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub


****

The code works great except for the loop. I am new to VBA so I hope someone can guide me in the right direction.

Essentially, the code is copying the Named Range Baby the number of times the Named Range BALL is in Column A of the Data.xlsx file (less one).

So, in the Named Range BALL is the number 4 - Baby pastes nicely 4x before the Named Range Total, but then the Baby pastes again 3x after the Named Rnage Total. I do not want it to paste the 3 extra times.

Any advice?

Thank you!

 

[Jerry Sullivan]

So, in the Named Range BALL is the number 4 - Baby pastes nicely 4x before the Named Range Total, but then the Baby pastes again 3x after the Named Rnage Total. I do not want it to paste the 3 extra times.

Hi Sundae,

The problem is that you are copying the Range("RUTH") twice on each iteration of the loop.

The first is here...the copied cells are Insert-Pasted above Range("Total")

Range("RUTH").Copy
Range("Total").Insert Shift:=xlDown

The second time is here...the copied cells are Pasted
below the last row of data [probably below Range("Total")]

nextrow = .Cells(Rows.Count, "A").End(xlUp).Row
Range("A" & nextrow + 1).PasteSpecial

You can drop this second set of statements to eliminate the duplication.

Since you are looping n-1 times, when you say "Baby pastes nicely 4x above" you are probably counting the pre-existing Range("RUTH") as one paste. That's fine as long as Baby always starts directly above Total. Otherwise, you'll want to remove the -1.

 

[Sundae]

Thank you! Thank you! Thank you!

 

[Jerry Sullivan]

Glad to help.

BTW, if you are going to insert a large number of rows,
it will be much faster to Insert X Rows in one step, then
copy down your Ruth Range, instead of doing multiple Inserts.

Good luck!

 

[Sundae]

Hi there, I am now running this VBA code in another workbook and I am getting this error message - Insert Method of Range class failed - I tried searching on the net and found something about CopyOrigin, but that did not work.

Any advice would be appreciated.

Thanks,

 

[Jerry Sullivan]

Try using this Sub instead. It uses the approach I suggested in the earlier post of inserting all the rows first then copying the range instead of looping.

Sub Copy_Rows2()
    Dim lCopies As Long
    Application.ScreenUpdating = False
    
    lCopies = WorksheetFunction.CountIf(Workbooks("Data.xlsx") _
        .Worksheets("Sheet1").Columns("A"), Range("BALL")) - 1
    
    With Worksheets("Baby").Range("Total").Resize(lCopies)
        .EntireRow.Insert Shift:=xlDown
        Range("RUTH").Copy Destination:= _
            .Resize(, Range("Ruth").Columns.Count) _
            .Offset(-1 * lCopies, 0)
    End With

    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

 

[Sundae]

Thanks Jerry, but I am still getting the same error message at the .EntireRow.Insert Shift:=xlDown

Any suggestions?

Thanks,

 

[Jerry Sullivan]

Is there anything else different about this workbook? such as ...
Protected Sheet
PivotTables on Rows you are trying to insert
Tables (ListObject) on Rows you are trying to insert

 

[Sundae]

Yes - the worksheeet was protected. UUGHH!!

Thanks so much.

 

[Jerry Sullivan]

Glad it was something easy to fix like that. Cheers!