any way i can re-write this?

Posted by randy on September 14, 2001 11:30 AM

My 'if not is empty range' needs to increase by 1 each time (b8,b9,b10...etc) and my criteria range needs to change by 1 also (ae1,af1,ag1..etc)

right now i have 13 of these if thens and want to switch it to some sort of loop (mabey)

If Not IsEmpty(Range("INFO!B8")) Then
Sheets("SHEET3").Range("SHEET3!$P$1:$AB$500").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
"SHEET3!$AE$1:$AE$2"), CopyToRange:=Range("SHEET3!$AS$1:$BE$1"), Unique:=False
Sheets("SINGLE").Select
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
End If

If Not IsEmpty(Range("INFO!B9")) Then
Sheets("SHEET3").Range("SHEET3!$P$1:$AB$500").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
"SHEET3!$AF$1:$AF$2"), CopyToRange:=Range("SHEET3!$AS$1:$BE$1"), Unique:=False
Sheets("SINGLE").Select
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
End If

Posted by Russell Hauf on September 14, 2001 11:43 AM

Here's a quick & dirty loop for you - hope it works.

-Russell

Sub Loopy()

Dim intRow As Integer
Dim intCol As Integer

intCol = 31 ' This corresponds to column AE

For intRow = 8 To 20 ' this would be 13 rows

Sheets("INFO").Select
If Not IsEmpty(Cells(intRow, intCol)) Then
Sheets("SHEET3").Select
Sheets("SHEET3").Range("SHEET3!$P$1:$AB$500").AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=Sheets("SHEET3").Range(Cells(intCol, 1), Cells(intCol, 2)), _
CopyToRange:=Range("SHEET3!$AS$1:$BE$1"), Unique:=False

Sheets("SINGLE").Select
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True

End If

intCol = intCol + 1

Next intRow

End Sub

-------------------------------------------