Creating a For Loop using a named list - vba

Question

I'm trying to create a for loop for the code below.
The list of account as below:
[]
For Each Account In Accounts
With Range("A1", "K" & lngLastRow)
.AutoFilter
.AutoFilter Field:=1, Criteria1:=Account
.Copy OKSheet.Range("A1")
.AutoFilter
End With
Sheets("Summary").Select
Range("A1").Select
Selection.End(xlDown).Offset(2, 0).Select
Next Accounts

Answer 1

So without further info lets have a look at what could be changed with respect to what you have posted:
1) I can't see your variable declarations so i don't know how, and whether, you declared your variables, nor if you have Option Explicit at the top. So you could be getting errors such as Type mismatch or Application-defined or Object-defined error. We don't know as you don't state.
2) With Range("A1", "K" & lngLastRow) We don't know how you have calculated lngLastRow so this might terminate prematurely due to empty cells in a column.
It also implicitly references the Activesheet as isn't fully qualified as a range.
3) For Each Account In Accounts We don't know the variables types here so this might cause a type mismatch error, for example. I am unsure if Accounts, is meant to be a Range or a Named Range (or something else, possibly an Array)?
4) .Copy OKSheet.Range("A1") Inside a loop, without incrementing in some way, you will overwrite cell A1 with the contents of the filter at the current loop iteration. Meaning, you will end up with whatever the last filter criteria was in cell A1 in the destination sheet.
5) 1st .AutoFilter You clear the filter at the end of each loop so this may be redundant, depends on whether range is already filtered at start of loop.
6) The following three lines, within the loop, i think are redundant, as they don't actually do anything (except potentially produce an error) since your loop is over a defined range (Definitely a collection object or Array, we hope) and you will be returning to the next element.
Sheets("Summary").Select
Range("A1").Select
Selection.End(xlDown).Offset(2, 0).Select
And even if it were not looping to a specified range, you don't functionally achieve anything with these steps that couldn't be done with a single cell selection outside of the loop.
The following
Sheets("Summary").Select
As one should avoid .Select, where possible, could become
Sheets("Summary").Activate
if there is not something in cell A2, or beyond, then the following line has taken us to the land of Application defined or object defined error by trying to jump off the end of the spreadsheet.
Selection.End(xlDown).Offset(2, 0).Select
Selection.End(xlDown) has taken us to the last row in the sheet and then there is an attempt to offset a further two rows.
You could use (and i suspect outside of the loop)
Sheets("Summary").Cells(Sheets("Summary").Rows.Count, "A").End(xlUp).Offset(2, 0).Activate
With that in mind
With Accounts as a Range object code might look like:
Option Explicit
Public Sub TEST()
Dim Accounts As Range 'Variable declarations
Dim Account As Range
Dim wb As Workbook
Dim wsSource As Worksheet
Dim OKSheet As Worksheet
Set wb = ThisWorkbook 'Variable assignments
Set wsSource = wb.Worksheets("Sheet1")
Set OKSheet = wb.Worksheets("Sheet2")
Dim lngLastRow As Long
Dim nextOKRow As Long
lngLastRow = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row 'find last row by coming from the bottom of the sheet and finding last used cell in column
Set Accounts = wsSource.Range("A1:A" & lngLastRow) 'define Accounts
For Each Account In Accounts
nextOKRow = OKSheet.Cells(OKSheet.Rows.Count, "A").End(xlUp).Row 'increment where you paste
If nextOKRow > 1 Then nextOKRow = nextOKRow + 1
With wsSource.Range("A1:K" & lngLastRow) 'fully qualify range 'could also have as With wsSource.Range("A1", "K" & lngLastRow)
.AutoFilter 'redundant?
.AutoFilter Field:=1, Criteria1:=Account
.Copy OKSheet.Range("A" & nextOKRow) 'here you were just pasting over the same cell each time
.AutoFilter
End With
' Sheets("Summary").Range("A1").Activate
'Selection.End(xlDown).Offset(2, 0).Select ' off the sheet. 'not actually doing anything as you revisit the next Account range
Next Account
''Potentially uncomment the following two lines
'Sheets("Summary").Activate
'Sheets("Summary").Cells(Sheets("Summary").Rows.Count, "A").End(xlUp).Offset(2, 0).Activate
End Sub
With Accounts as a Named Range:
Public Sub TEST2()
Dim Account As Range
Dim wb As Workbook
Dim wsSource As Worksheet
Dim OKSheet As Worksheet
Set wb = ThisWorkbook
Set wsSource = wb.Worksheets("Sheet1")
Set OKSheet = wb.Worksheets("Sheet2")
Dim lngLastRow As Long
Dim nextOKRow As Long
lngLastRow = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row
wsSource.Range("A1:A" & lngLastRow).Name = "Accounts"
For Each Account In wb.Names("Accounts").RefersToRange
nextOKRow = OKSheet.Cells(OKSheet.Rows.Count, "A").End(xlUp).Row
If nextOKRow > 1 Then nextOKRow = nextOKRow + 1
With wsSource.Range("A1:K" & lngLastRow)
.AutoFilter
.AutoFilter Field:=1, Criteria1:=Account
.Copy OKSheet.Range("A" & nextOKRow)
.AutoFilter
End With
Next Account
End Sub
With Accounts as an Array:
Public Sub TEST3()
Dim Accounts() 'Variable declarations
Dim Account As Variant
Dim wb As Workbook
Dim wsSource As Worksheet
Dim OKSheet As Worksheet
Set wb = ThisWorkbook
Set wsSource = wb.Worksheets("Sheet1")
Set OKSheet = wb.Worksheets("Sheet2")
Dim lngLastRow As Long
Dim nextOKRow As Long
lngLastRow = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row
Accounts = wsSource.Range("A1:A" & lngLastRow).Value
For Each Account In Accounts
nextOKRow = OKSheet.Cells(OKSheet.Rows.Count, "A").End(xlUp).Row
If nextOKRow > 1 Then nextOKRow = nextOKRow + 1
With wsSource.Range("A1:K" & lngLastRow)
.AutoFilter
.AutoFilter Field:=1, Criteria1:=Account
.Copy OKSheet.Range("A" & nextOKRow)
End With
Next Account
End Sub