Iteration in Autofilter using VBA

[Ron_N]

Hi,

Is there a way to iterate through the different selections of an autofilter via VBA? Is there any kind of code that would help me select each item in the autofilter one by one, so that i could apply some formulae to it.

Now i have the following code:

Range("A1").Select
Selection.autofilter
ActiveSheet.Range("$A$1:$W$12").autofilter Field:=4, Criteria1:= _
"Inv Copies"

a = ActiveSheet.Range("a1", ActiveSheet.Range("a1").End(xlDown)).Count

b = a * 0.25
c = b + 1

Rows(Irow + c).Resize(ActiveSheet.Range("a1", ActiveSheet.Range("a1"). _
End(xlDown)).Count - c).Delete

ActiveSheet.Range("$A$1:$W$12").autofilter Field:=4, Criteria1:= _
"Closing Future"

a = ActiveSheet.Range("a1", ActiveSheet.Range("a1").End(xlDown)).Count

b = a * 0.25
c = b + 1

Rows(Irow + c).Resize(ActiveSheet.Range("a1", ActiveSheet.Range("a1"). _
End(xlDown)).Count - c).Delete

---------------------------------------------------------
but i donot want to mention the criteria again and again. Moreover i may have a new list tomorrow where i may add/delete certain names. So i want a dynamic code which will select each item in the autofilter one by one and apply the formula.
i am sorry for my ignorance but i am very new to VBA.
Can anybody help me out. It is urgent!

thank you,
Ron_N

 

[ncalenti]

To make sure i understand:
you want it to go through all the dropdown options of field 4 in your autofiler and do this

b = a * 0.25
        c = b + 1
        
        Rows(Irow + c).Resize(ActiveSheet.Range("a1", ActiveSheet.Range("a1"). _
        End(xlDown)).Count - c).Delete

right?

 

[Ron_N]

Hello..

Yes, you have got it right. I will be very glad if you can help me out with this.

Thank you

 

[Richard Schollar]

Hi Ron

So you need a list (or array) of the distinct values in your D column? You can use the Dictionary object to generate this (among other ways) eg:

Dim dic As Object
Dim rngAllValues As Range, cell As Range
Dim arrUniqueValues As Variant
Dim i As Long

Set dic = CreateObject("Scripting.Dictionary")
Set rngAllValues = Range("D2:D" & Cells(Rows.Count, "D").End(xlUp).Row)  'this is your entire list of values in Column D
 
'iterate thru column D values, extracting unique entries:
For Each cell In rngAllValues
    If Not dic.exists(cell.Value) Then _
        dic.Add cell.Value, cell.Value
Next cell
'dic now holds all unique entries - get them into your array via:
arrUniqueValues = dic.Keys
'use the unique values:
For i = LBound(arrUniqueValues) To UBound(arrUniqueValues)
    'MsgBox arrUniqueValues(i)
    range(A1:G1).autofilter field:=4, criteria1:=arrUniqueValues(i)
Next i

 

[Ron_N]

Hi Richard,

Thank you for the quick reply. I will try this straightaway.

thanks
Ron

 

[Ron_N]

Thank you Richard,

It worked like wonders. My code is working perfectly...


Ron