CODEWITHSUNDEEP
vbaexcelnamed-ranges
dexterd
dexterd

Reputation: 13

Looping through Dynamic Named Range in VBA

I have a nested loop on a dynamic named range in Sheet2 "TransTypes" which I defined as:

=OFFSET(Sheet2!$A$1,0,0,COUNTA(Sheet2!A:A),1)

and my looping is as follows:

Sub Repeat_trans_type()
    Dim Trans_type_count As Integer, wb As Workbook, wsMain As Worksheet, nwb As Workbook
    Dim i As Integer, nws As Worksheet, wsSheet2 As Worksheet, j As Integer, cell As Range
    Dim k As Integer


    Trans_type_count = Sheet2.Range("A:A").Cells.SpecialCells(xlCellTypeConstants).Count

    Application.ScreenUpdating = False

    Set wb = Workbooks("Book1.xlsm")
    Set wsMain = wb.Sheets("Sheet1")
    Set wsSheet2 = wb.Sheets("Sheet2")

    j = 1
    k = 1

Set nwb = Workbooks.Add
Set nws = nwb.Sheets(1)

For j = 1 To 96
        i = 1
        Set cell = Nothing
        For Each cell In wsSheet2.Names("TransTypes").RefersToRange.Cells            
        wsMain.Range("A" & j, "C" & j).Copy
        nws.Range("A" & k).PasteSpecial xlPasteValues
        nws.Range("A" & k).PasteSpecial xlPasteFormats
        wsSheet2.Range("A" & i).Copy
        nws.Range("D" & k).PasteSpecial xlPasteValues
        nws.Range("D" & k).PasteSpecial xlPasteFormats
        i = i + 1
        k = k + 1
    Next cell
    Next j
End Sub

The first iteration of nested loop works fine but when it starts executing for second time, i.e j=2, I get the error message:

Application-defined or object-defined error

As of now, I have worked around this by using below:

For Each cell In wsSheet2.Range("A1", wsSheet2.Range("A1").End(xlDown))

instead of directly using the named range.

Any ideas on why the offset approach is not working would be appreciated.

Thanks.

Upvotes: 1

Views: 4251

Answers (1)

Pᴇʜ
Pᴇʜ

Reputation: 57743

Hard to say whats wrong here but I suggest you try the following:

  • use For Each cell In wsSheet2.Range("TransTypes").Cells in for/each
For j = 1 To 96
    i = 1
    Set cell = Nothing
    For Each cell In wsSheet2.Range("TransTypes").Cells 'changed this line (2)
        wsMain.Range("A" & j, "C" & j).Copy
        nws.Range("A" & k).PasteSpecial xlPasteValues
        nws.Range("A" & k).PasteSpecial xlPasteFormats
        wsSheet2.Range("A" & i).Copy
        nws.Range("D" & k).PasteSpecial xlPasteValues
        nws.Range("D" & k).PasteSpecial xlPasteFormats
        i = i + 1
        k = k + 1
    Next cell
Next j

Upvotes: 1

Related Questions