Robert Jr asks:

Oscar,
I am using the VBA code & FilterUniqueSort array to generate unique lists that drive Selection Change AutoFilter on multiple colums. Is there a way to make the list only return the unique values that are visible in the filtered source data?

I see a similar answer above using just an array formula, but my source is too long for that to be practical. Any help would be greatly appreciated.

Robert Jr

Answer:

I modified a formula by Laurent Longre found here: Excel Experts E-letter from John Walkenbach's web site.

Array Formula in cell B26:

=INDEX(Table2[First Name],MATCH(0,(IF(SUBTOTAL(3, OFFSET(Table2[First Name], MATCH(ROW(Table2[First Name]), ROW(Table2[First Name]))-1, 0, 1)), MATCH(ROW(Table2[First Name]), ROW(Table2[First Name])),""))*COUNTIF($B$25:B25,Table2[First Name]),0))

How to create an array formula

  1. Select cell B26
  2. Type array formula in formula bar
  3. Press and hold Ctrl + Shift
  4. Press Enter once
  5. Release all keys

How to copy array formula

  1. Select cell B26
  2. Copy cell (Ctrl + c)
  3. Select cell range B27:B30
  4. Paste (Ctrl + v)

User defined function FilterUniqueSortTable(range)

Function FilterUniqueSortTable(rng As Range)
Dim ucoll As New Collection, Value As Variant, temp() As Variant
Dim iRows As Single, i As Single
ReDim temp(0)
On Error Resume Next
For Each Value In rng
    If Len(Value) > 0 And Value.EntireRow.Hidden = False Then
        ucoll.Add Value, CStr(Value)
    End If
Next Value
On Error GoTo 0
For Each Value In ucoll
    temp(UBound(temp)) = Value
    ReDim Preserve temp(UBound(temp) + 1)
Next Value
ReDim Preserve temp(UBound(temp) - 1)
iRows = Range(Application.Caller.Address).Rows.Count
SelectionSort temp
For i = UBound(temp) To iRows
  ReDim Preserve temp(UBound(temp) + 1)
  temp(UBound(temp)) = ""
Next i
FilterUniqueSortTable = Application.Transpose(temp)
End Function</pre>

Where to copy code?

Press Alt+F11

User defined function in cell range A26:A31:

=FilterUniqueSortTable(Table2[First Name])

How to create array formula

  1. Select cell range A26:A31
  2. Type above formula in formula bar
  3. Press and hold Ctrl + Shift
  4. Press Enter once
  5. Release all keys

Download excel 2007 *.xlsm file

Extract unique distinct values from a filtered table.xlsm