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

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

Collectives™ on Stack Overflow

Looping through Dynamic Named Range in VBA

1 Answer 1

1 Comment

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

1 Comment

Related