PDA

View Full Version : Excel 2013>VBA>Named Range>Display filtered range in listbox



aworthey
07-22-2016, 08:53 AM
Hello,

I'm trying to utilize the worksheet function data filter to filter a named range, then display the visible list in a userform listbox. It seems that I'm close to figuring it out...I believe this code even worked the way I wanted it to at first...but now it only displays the entire named range every time.

When I first tested this code, I could click on the filtered worksheet and see that the filters were activated at the top of each column. But now I don't see the filters at all.

Here's the code:


Option Explicit
Private Sub CommandButton1_Click()
Dim srchString As Variant
Dim mtchString As Variant
Dim rng As Range
Dim uniques
'MsgBox Me.ComboBox1.Value
srchString = Me.ComboBox1.Value
With Range("GeneratorModels")
Set mtchString = .Find(srchString, LookIn:=xlValues)
'MsgBox mtchString.Column
.AutoFilter field:=mtchString.Column - 28, Criteria1:="1"
End With

Set rng = Range("ESDescription")
rng.AdvancedFilter Action:=xlFilterInPlace, Unique:=True
uniques = Application.WorksheetFunction.Transpose(Intersect(rng, rng.Offset(1, 0)).SpecialCells(xlCellTypeVisible).Value)
Me.ListBox1.List = uniques
End Sub

p45cal
07-22-2016, 09:46 AM
I dare you - supply a workbook…

In the meantime I can only guess; this will take a single column list starting at A1 (a header) down, advanced filter it to uniques, and put the values into an array called uniques.
Your problem stems from not being able to take a non-contiguous range and plonk all its values into an array in one shot (it will only do that for the first area of the non-contiguous range).

Sub blah()
Dim Uniques()
Set Rng = Range("A1").CurrentRegion
Rng.AdvancedFilter Action:=xlFilterInPlace, Unique:=True
Set myUniques = Intersect(Rng, Rng.Offset(1, 0)).SpecialCells(xlCellTypeVisible)
ReDim Uniques(1 To myUniques.Cells.Count / myUniques.Columns.Count) 'a way to count visible rows.
i = 1
For Each are In myUniques.Areas
For Each cll In are.Cells
Uniques(i) = cll.Value
i = i + 1
Next cll
Next are
'uniques should contain the unique values at this point.
ActiveSheet.ShowAllData
End Sub