CODEWITHSUNDEEP
excelvba
dotsent12
dotsent12

Reputation: 137

Excel VBA filter loop

Any suggestions how to tackle the following problem? I have a list of ~15 different items, out of which only some are present in a table (Excel 2016) at any particular moment.

I want to use VBA in order to loop through the existing table range and filter it based on every distinct Item. When found, I want to launch additional code.

I don't have a problem with a simple code to look for and filter out one hardcoded item and if found, run another code snippet and if not, quit. However I feel there must be a better option as scheduling 15 different scripts to run is very inefficient and I'd also need to start them one by one.

Any suggestions on how to do this with 1 code, instead of running 15 different ones?

A dummy table is perhaps better explanatory - out of total 15 different items, it currently has 4 different ones. I'd like loop though the table and filter out each Item separately and run the code with each of them.

enter image description here

This is what I came up with, but this one would only work if duplicated and launched 15 times with different hardcoded filtering criterias:

Sub Filter_single ()

Dim Filtered as Range  
Set Filtered = Sheets("Sheet1").Range("Table1").SpecialCells(xlCellTypeVisible)

    With ActiveSheet.ListObjects("Table1").Range
        .AutoFilter Field:=1, Criteria1:="Apple"

    End With

If Filtered is Nothing Then
End If

... if range "Filtered" is not Nothing, run another code here...

End Sub

Upvotes: 0

Views: 2496

Answers (1)

urdearboy
urdearboy

Reputation: 14590

Nest your code inside a unique value loop. I just hard coded the values of Arr here, but you can load this in various ways (all of which are well documented on this site)

Sub Filter_single()

Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1")
Dim Filtered As Range, i As Long, Arr

Arr = Array("Apple", "Orange", "Grape")

For i = LBound(Arr) To UBound(Arr)
    With ws.ListObjects("Table1").Range
        .AutoFilter Field:=1, Criteria1:="Apple"
        Set Filtered = .SpecialCells(xlCellTypeVisible)
    End With

    If Filtered.Rows.Count > 1 And Not Filtered Is Nothing Then
        'Run Macro Here
    End If

    Set Filtered = Nothing
Next i

End Sub

Upvotes: 1

Related Questions