Looping through Dynamic Named Range in VBA

Question

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.

Not sure what your For each loop is doing at all - it's not referenced in the loop at all? You should probably post all your code. — SJR
– SJR, Commented Mar 8, 2017 at 12:59
did you try my answer below? Because it solved the problem in my test case. — Pᴇʜ
– Pᴇʜ, Commented Mar 8, 2017 at 13:25

Pᴇʜ · Accepted Answer · 2017-03-08 13:13:31Z

1

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

edited Mar 8, 2017 at 13:13

answered Mar 8, 2017 at 13:07

Pᴇʜ

57.9k10 gold badges55 silver badges75 bronze badges

Sign up to request clarification or add additional context in comments.

1 Comment

dexterd Over a year ago

Thank you! Works like a charm.

Collectives™ on Stack Overflow

Looping through Dynamic Named Range in VBA

1 Answer 1

1 Comment

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

1 Comment

Your Answer

Sign up or log in

Post as a guest

Related