CODEWITHSUNDEEP
excelvba
Alan Wong
Alan Wong

Reputation: 19

Looping through each cell, and if match, grab value and add to list/array which will like to use it for autofilter

Self explanatory subject. The problem I face now is that my exrcif is not increasing as I would like to include a list of criteria in the autofilter.

Currently I have this code:

    Dim oneCell as Range
    Dim exrcif as String

    For each oneCell in Range(“H2:H1000”)    
        With oneCell    
            If oneCell.value = 0 Then    
                exrcif = oneCell.Offset(,-7).Value    
                Exit For
            End If
        End With
    Next oneCell

    Range(“A:H”).AutoFilter Field:=4, , Criteria1:=exrcif
End sub

Upvotes: 1

Views: 39

Answers (2)

Pᴇʜ
Pᴇʜ

Reputation: 57733

The issue you have is that your exrcif is a String and no array and 

exrcif = oneCell.Offset(,-7).Value

overwrites that string in each iteration. Instead you must append the value to an array:

For example write a procedure to append a value to an array

Option Explicit

Public Sub AppendToArray(ByRef Arr() As Variant, ByVal AppendValue As Variant)
    Dim ArrSize As Long
    ArrSize = -1

    On Error Resume Next
    ArrSize = UBound(Arr)
    On Error GoTo 0

    ReDim Preserve Arr(ArrSize + 1)
    Arr(ArrSize + 1) = AppendValue
End Sub

And use it like below

Public Sub test()
    Dim exrcif() As Variant

    Dim oneCell As Range
    For Each oneCell In Range("H2:H1000")
        If oneCell.Value = 0 Then
            AppendToArray Arr:=exrcif, AppendValue:=oneCell.Offset(, -7).Value
            'note no Exit For here! Otherwise it will stop after the first found 0
        End If
    Next oneCell

    Range("A:H").AutoFilter Field:=4, Criteria1:=exrcif, Operator:=xlFilterValues
End Sub

Upvotes: 2

Vasily
Vasily

Reputation: 5782

variant using Scripting.Dictionary

Sub test()
    Dim oneCell As Range
    Dim exrcif As Object: Set exrcif = CreateObject("Scripting.Dictionary")
    For Each oneCell In Range("H2:H1000")
        With oneCell
            If oneCell.Value = 0 And _
                oneCell.Value <> "" And _
                Not exrcif.exists(oneCell.Offset(, -7).Value) Then
                exrcif.Add oneCell.Offset(, -7).Value, Nothing
            End If
        End With
    Next oneCell
    Range("A:H").AutoFilter Field:=4, Criteria1:=exrcif.Keys, Operator:=xlFilterValues
End Sub

test: enter image description here

Upvotes: 1

Related Questions