Filter by NEXT unique data value VBA

[McMasher]

I have a table with three columns: Style, Color, Size. What I want to be able to do is hit a "Next" button, and it will change the filter on the table to whatever the next unique Style is within this table.

My Example:

Full table:
[TABLE="class: grid, width: 500, align: left"]
<tbody>[TR]
[TD]Style[/TD]
[TD]Color[/TD]
[TD]Size[/TD]
[/TR]
[TR]
[TD]Ardvarkian[/TD]
[TD]Red[/TD]
[TD]Small[/TD]
[/TR]
[TR]
[TD]Ardvarkian[/TD]
[TD]Red[/TD]
[TD]Medium[/TD]
[/TR]
[TR]
[TD]Bouncy[/TD]
[TD]Blue[/TD]
[TD]Medium[/TD]
[/TR]
[TR]
[TD]Bouncy[/TD]
[TD]Blue[/TD]
[TD]Large[/TD]
[/TR]
[TR]
[TD]Bubbly[/TD]
[TD]Pink[/TD]
[TD]Small[/TD]
[/TR]
[TR]
[TD]Bubbly[/TD]
[TD]Pink[/TD]
[TD]Medium[/TD]
[/TR]
[TR]
[TD]Zymph[/TD]
[TD]Black/White[/TD]
[TD]Large[/TD]
[/TR]
[TR]
[TD]Zymph[/TD]
[TD]Black/White[/TD]
[TD]X_Large[/TD]
[/TR]
</tbody>[/TABLE]

First Filter:
[TABLE="class: grid, width: 500, align: left"]
<tbody>[TR]
[TD]Ardvarkian[/TD]
[TD]Red[/TD]
[TD]Small[/TD]
[/TR]
[TR]
[TD]Ardvarkian[/TD]
[TD]Red[/TD]
[TD]Medium[/TD]
[/TR]
</tbody>[/TABLE]

Then I would hit NEXT and would see this:
[TABLE="class: grid, width: 500, align: left"]
<tbody>[TR]
[TD]Bouncy[/TD]
[TD]Blue[/TD]
[TD]Medium[/TD]
[/TR]
[TR]
[TD]Bouncy[/TD]
[TD]Blue[/TD]
[TD]Large[/TD]
[/TR]
</tbody>[/TABLE]

Then NEXT again:
[TABLE="class: grid, width: 500, align: left"]
<tbody>[TR]
[TD]Bubbly[/TD]
[TD]Pink[/TD]
[TD]Small[/TD]
[/TR]
[TR]
[TD]Bubbly[/TD]
[TD]Pink[/TD]
[TD]Medium[/TD]
[/TR]
</tbody>[/TABLE]




Etc. etc.


Thanks in advance for all your help!!!

~McMasher

 

[VBA Geek]

your table begins in A1?

try:

Private aUniques As Variant, Cntr As Long


Sub filter_NEXT()
If (Not ActiveSheet.AutoFilterMode) Or (IsEmpty(aUniques)) Then
    Cntr = 0
    With Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)
        aUniques = Filter(Evaluate(Replace("=TRANSPOSE(IF(MATCH(@,@,0)=ROW(@)-ROW(A2)+1,@,""###""))", "@", .Address)), "###", 0)
    End With
    Range("A1").CurrentRegion.AutoFilter 1, aUniques(0)
Else
    Cntr = 1 + Cntr
    Range("A1").CurrentRegion.AutoFilter 1, aUniques((Cntr Mod (1 + UBound(aUniques))))
End If
End Sub

 

[McMasher]

VBA Geek,

Thank you for your impressive code...It didn't actually work for me, HOWEVER, your formula with the loop counter

Cntr = 1 + Cntr

Made me think of a formula I could use in an added column that would give me a numerical sequence to my style changes.

Here is the formula I am using:

=IF($AG23="Unique Value Count", 1,IF($B24<>$B23,AG23+1,$AG23))

Where Unique Value count is the column header. Basically I knew my Styles were sorted alphabetically so I don't need to worry that a style will show up in row 25 and then again in line 500 for example.

I'm going to use this column along with the following code:

Sub NextItem()

Range("B5").Value = Range("B5").Value + 1
ActiveWorkbook.Worksheets("Item Qty by Whs DB").ListObjects("tblItemQty").Range.AutoFilter Field:=33, Criteria1:="=" & Range("B5")

End Sub

Thanks again!!!

~McMasher

 

[VBA Geek]

Hello, thanks for feedback.

by looking at your formulas, I am guessing my solution did not work as your table mustn't be located in columns A:C, starting in A1

if you let me know where does your table begin I can update the code

VBA Geek,

Thank you for your impressive code...It didn't actually work for me, HOWEVER, your formula with the loop counter

Cntr = 1 + Cntr

Made me think of a formula I could use in an added column that would give me a numerical sequence to my style changes.

Here is the formula I am using:

=IF($AG23="Unique Value Count", 1,IF($B24<>$B23,AG23+1,$AG23))

Where Unique Value count is the column header. Basically I knew my Styles were sorted alphabetically so I don't need to worry that a style will show up in row 25 and then again in line 500 for example.

I'm going to use this column along with the following code:

Sub NextItem()

Range("B5").Value = Range("B5").Value + 1
ActiveWorkbook.Worksheets("Item Qty by Whs DB").ListObjects("tblItemQty").Range.AutoFilter Field:=33, Criteria1:="=" & Range("B5")

End Sub

Thanks again!!!

~McMasher