[excel] Easiest way to loop through a filtered list with VBA?

If I have an auto filter set up in Excel and I want to loop through all the visible data in one column with VBA code, what's the easiest way to do this?

All the hidden rows that have been filtered away should not be included, so a plain Range from top to bottom doesn't help.

Any good ideas?

This question is related to excel vba

The answer is


One way assuming filtered data in A1 downwards;

dim Rng as Range
set Rng = Range("A2", Range("A2").End(xlDown)).Cells.SpecialCells(xlCellTypeVisible)
...
for each cell in Rng 
   ...     

The SpecialCells Does not actually work as it needs to be continuous. I have solved this by adding a sort funtion in order to sort the data based on the coloumns i need.

Sorry for no comments on the code as i was not planning to share it:

Sub testtt()
    arr = FilterAndGetData(Worksheets("Data").range("A:K"), Array(1, 9), Array("george", "WeeklyCash"), Array(1, 2, 3, 10, 11), 1)
    Debug.Print sms(arr)
End Sub
Function FilterAndGetData(ByVal rng As Variant, ByVal fields As Variant, ByVal criterias As Variant, ByVal colstoreturn As Variant, ByVal headers As Boolean) As Variant
Dim SUset, EAset, CMset
If Application.ScreenUpdating Then Application.ScreenUpdating = False: SUset = False Else SUset = True
If Application.EnableEvents Then Application.EnableEvents = False: EAset = False Else EAset = True
If Application.Calculation = xlCalculationAutomatic Then Application.Calculation = xlCalculationManual: CMset = False Else CMset = True
For Each col In rng.Columns: col.Hidden = False: Next col

Dim oldsheet, scol, ecol, srow, hyesno As String
Dim i, counter As Integer

oldsheet = ActiveSheet.Name


Worksheets(rng.Worksheet.Name).Activate

Worksheets(rng.Worksheet.Name).AutoFilterMode = False

scol = Chr(rng.Column + 64)
ecol = Chr(rng.Columns.Count + rng.Column + 64 - 1)
srow = rng.row

If UBound(fields) - LBound(fields) <> UBound(criterias) - LBound(criterias) Then FilterAndGetData = "Fields&Crit. counts dont match": GoTo done

dd = sortrange(rng, colstoreturn, headers)

For i = LBound(fields) To UBound(fields)
    rng.AutoFilter Field:=CStr(fields(i)), Criteria1:=CStr(criterias(i))
Next i

Dim rngg As Variant

rngg = rng.SpecialCells(xlCellTypeVisible)
Debug.Print ActiveSheet.AutoFilter.range.address
FilterAndGetData = ActiveSheet.AutoFilter.range.SpecialCells(xlCellTypeVisible).Value

For Each row In rng.Rows
    If row.EntireRow.Hidden Then Debug.Print yes
Next row


done:
    'Worksheets("Data").AutoFilterMode = False
    Worksheets(oldsheet).Activate
    If SUset Then Application.ScreenUpdating = True
    If EAset Then Application.EnableEvents = True
    If CMset Then Application.Calculation = xlCalculationAutomatic
End Function
Function sortrange(ByVal rng As Variant, ByVal colnumbers As Variant, ByVal headers As Boolean)

    Dim SUset, EAset, CMset
    If Application.ScreenUpdating Then Application.ScreenUpdating = False: SUset = False Else SUset = True
    If Application.EnableEvents Then Application.EnableEvents = False: EAset = False Else EAset = True
    If Application.Calculation = xlCalculationAutomatic Then Application.Calculation = xlCalculationManual: CMset = False Else CMset = True
    For Each col In rng.Columns: col.Hidden = False: Next col

    Dim oldsheet, scol, srow, sortcol, hyesno As String
    Dim i, counter As Integer
    oldsheet = ActiveSheet.Name
    Worksheets(rng.Worksheet.Name).Activate
    Worksheets(rng.Worksheet.Name).AutoFilterMode = False
    scol = rng.Column
    srow = rng.row

    If headers Then hyesno = xlYes Else hyesno = xlNo

    For i = LBound(colnumbers) To UBound(colnumbers)
        rng.Sort key1:=range(Chr(scol + colnumbers(i) + 63) + CStr(srow)), order1:=xlAscending, Header:=hyesno
    Next i
    sortrange = "123"
done:
    Worksheets(oldsheet).Activate
    If SUset Then Application.ScreenUpdating = True
    If EAset Then Application.EnableEvents = True
    If CMset Then Application.Calculation = xlCalculationAutomatic
End Function

Call MyMacro()

ActiveCell.Offset(1, 0).Activate

Do Until Selection.EntireRow.Hidden = False
If Selection.EntireRow.Hidden = True Then
ActiveCell.Offset(1, 0).Activate
End If
Loop

I would recommend using Offset assuming that the Headers are in Row 1. See this example

Option Explicit

Sub Sample()
    Dim rRange As Range, filRange As Range, Rng as Range
    'Remove any filters
    ActiveSheet.AutoFilterMode = False

    '~~> Set your range
    Set rRange = Sheets("Sheet1").Range("A1:E10")

    With rRange
        '~~> Set your criteria and filter
        .AutoFilter Field:=1, Criteria1:="=1"

        '~~> Filter, offset(to exclude headers)
        Set filRange = .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow

        Debug.Print filRange.Address

        For Each Rng In filRange
            '~~> Your Code
        Next
    End With

    'Remove any filters
    ActiveSheet.AutoFilterMode = False
End Sub

I used the RowHeight property of a range (which means cells as well). If it's zero then it's hidden. So just loop through all rows as you would normally but in the if condition check for that property as in If myRange.RowHeight > 0 then DoStuff where DoStuff is something you want to do with the visible cells.


a = 2
x = 0

Do Until Cells(a, 1).Value = ""
If Rows(a).Hidden = False Then
x = Cells(a, 1).Value + x
End If
a = a + 1
Loop

End Sub