CODEWITHSUNDEEP
excelvbafiltering
Mark Lazarides
Mark Lazarides

Reputation: 376

Returning unique value and avoid looping through an unfiltered range

First post on here, so I hope I'm clear enough.

I have a table on a worksheet that I am working with. I've passed the listObject to a class, which can return various bits of data from it. I'd like to retrieve a unique list, by filtering against a specified column heading.

My question is this:

Can I return a range containing all the rows, once filtered, without looping through the entire, unfiltered range manually?

My current code loops through the (unfiltered) range, looking for unique entries as below. It's taking a noticeable amount of time on my test worksheet, so don't think it'll be viable for the operational example.

Public Function returnUniqueList(col As String) As Collection
' get unqiue lists from the table.  Useful for things like LCPs or ballast types
' returns as list of strings

Dim i As Integer
Dim r As Excel.Range
Dim reqCol As Integer
Dim tempString As String
' collection of strings with the unique values
Dim retString As New Collection

reqCol = returnColId(col)

On Error GoTo errorCatch

' collect the unique values
For Each r In pLO.Range.rows

    If Not InCollection(retString, r.Cells(1, reqCol)) Then
        ' add to the collection, including the key
        If r.Cells(1, reqCol) <> "" Then
           retString.Add r.Cells(1, reqCol), r.Cells(1, reqCol)
        End If
    End If
Next r

Set returnUniqueList = retString
Exit Function
errorCatch:
  MsgBox "Error returning unique list: " + Err.Description

End Function

Upvotes: 2

Views: 943

Answers (1)

Mark Lazarides
Mark Lazarides

Reputation: 376

So after some messing around with various in-built excel/VBA functionality, I've settled on advanced filters. One of the issues I had, was that while I filtered on one column, I wanted to return the filtered table to the calling piece of code. The above function now looks like this:

Public Function returnUniqueList(col As String, searchTerm As String) As Excel.range
' get unique lists from the table.  Useful for things like LCPs or ballast types
' returns as excel.range

Dim reqCol As Integer

On Error GoTo errorCatch

reqCol = returnColId(col)
Dim critRange As String
Dim cr As Excel.range


critRange = "=""=" + searchTerm + "*"""

pWkSht.Cells(1, 1000) = col
pWkSht.Cells(2, 1000) = critRange

Set cr = pWkSht.range(pWkSht.Cells(1, 1000), pWkSht.Cells(2, 1000))
' filter for unique entries on this column
pLO.range.Columns(reqCol).Select
pLO.range.Columns(reqCol).AdvancedFilter Action:=xlFilterInPlace, Unique:=True, CriteriaRange:=cr


Set returnUniqueList = pLO.range.SpecialCells(xlCellTypeVisible).EntireRow
pWkSht.Cells(1, 1000) = Empty
pWkSht.Cells(2, 1000) = Empty
Exit Function

errorCatch:
MsgBox "Error returning unique list: " + Err.Description

End Function

The tricky thing I found was then working on the range in the calling function. I found that excel ranges can contain 'areas'. This is due to the way excel works with contiguous data. So in the calling function, I had to iterate through the areas in the returned ranges. This does add a level of overhead into the original calling function that I had hoped to avoid (I wanted to return a single range, with a single area that could easily be iterated through).

The most reliable method I found of iterating through the range/areas returned from the above is based around this snippet, which I use in loads of places in one fashion or another (different columns being pulled from the table, etc:

Set devices = edh.returnUniqueList("DaliCct", lcp)
' filter by the requested LCP

'clear down the dali ccts box
daliCctsListBox.Clear

' cycle through the returned areas, retrieving the relvant info
For i = 1 To devices.Areas.Count
    For rowInd = 1 To devices.Areas(i).rows.Count
        Dim r As Excel.range
        For Each r In devices.Areas(i).rows(rowInd)

         If (r.Cells(daliCctColId) <> "") And (r.Cells(daliCctColId) <> "DaliCct") Then
             daliCctsListBox.AddItem r.Cells(daliCctColId)
             bAdded = True
         End If
        Next r
    Next rowInd
Next i

Upvotes: 1

Related Questions