Excel (macro): understanding code - get unique values (rows & cols) to use in macro

Question

(First, I understand that this may work well for me - I'm trying to understand what's going on with a piece of code from somewhere else.)

I have a macro connected to buttons to hide columns and rows in range "rHFilter" that do not contain the value I want (whatever is in the drop-down in cell "M2"). To get the values for the drop-down, I am trying to check all the values in my range "rHFilter". enter image description here

I'm getting ~~duplicates in my code~~ multiple instances of values in my "strFilter" variable, though, and I don't understand what this bit is doing, exactly, that it allows duplicates:

    For Each c In Range("rHFilter").Cells
    If Application.CountIf(Range(Cells(3, 2), c), c.Value) = 1 Then
        strFilter = strFilter & "," & c.Value
    End If
    Next c

That seems to be the smallest way to get unique values from a range to use in my macro - but if I can't make it work, I'm looking at trying the "collection" code from the other page. Can anyone help me?

As an aside, I don't understand what this is doing, either:

'=========
'What is this statement supposed to do?
'If Application.CountIf(ThisWorkbook.Sheets(1).Columns(2), "-") _
   = Range("rHFilter").Rows.Count Then Exit Sub
'=========

Here's the larger bit of code (for anyone interested):

    Sub SetrHFilterRange()
    On Error Resume Next
    Application.ScreenUpdating = False
    strSN = ActiveSheet.name
    Set ws = Sheets(strSN)

    ' Get the Last Cell of the Used Range
    ' Set lastCell = ThisWorkbook.Sheets(1).usedRange.SpecialCells(xlCellTypeLastCell)
    Set lastCell = ws.Columns("B:G").Find("*", ws.[B3], xlValues, , xlByRows, xlPrevious)
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    Set usedRange = Range("B3:G" & lastRow)

    ' Reset Range "rHFilter" from Cell C2 to last cell in Used Range
    ThisWorkbook.Names.Add name:="rHFilter", RefersTo:=usedRange

    ' Set filtering cell value and formatting
    With Cells(2, 13)
        .Value = "-"
        .FormatConditions.Delete
        .FormatConditions.Add Type:=xlCellValue, Operator:=xlNotEqual, Formula1:="=""-"""
        .FormatConditions(1).Interior.ColorIndex = 44
        .Interior.ColorIndex = 17
    End With

    strFilter = "-"

    For Each c In Range("rHFilter").Cells
        If Application.CountIf(Range(Cells(3, 2), c), c.Value) = 1 Then
            strFilter = strFilter & "," & c.Value
        End If
    Next c

    With Cells(2, 13).Validation
        .Delete
        .Add Type:=xlValidateList, Formula1:=strFilter & ",Blank Cells"
        .InCellDropdown = True
    End With

    strFilter = ""
    Application.ScreenUpdating = True

    On Error GoTo 0

End Sub

Sub SetrHFilter()

    strSN = ActiveSheet.name
    Set ws = Sheets(strSN)

    If lastCell Is Nothing Then
        Set lastCell = ws.Columns("B:G").Find("*", ws.[B3], xlValues, , xlByRows, xlPrevious)
    End If

    On Error Resume Next
'=========
    'What is this statement supposed to do?
    'If Application.CountIf(ThisWorkbook.Sheets(1).Columns(2), "-") _
       = Range("rHFilter").Rows.Count Then Exit Sub
'=========

    ' reset unhide in case the user didn't clear
    ThisWorkbook.Sheets(1).Columns.Hidden = False
    ThisWorkbook.Sheets(1).Rows.Hidden = False

    eName = Cells(2, 13).Value
    If eName = "-" Then Exit Sub

    ' Speed the code up changing the Application settings
    With Application
        lCalc = .Calculation
        .Calculation = xlCalculationManual
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    FilterRowsNCols:

    ' Hide columns if cells don't match the values in filter cell
    If eName <> "Blank Cells" Then
        For Each hFilterCol In Range("rHFilter").Columns
            Set fName = hFilterCol.Find(what:=eName, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
                                                        SearchDirection:=xlNext, MatchCase:=False)
            If fName Is Nothing Then 'not found
                hFilterCol.EntireColumn.Hidden = True
            End If
        Next hFilterCol
    Else
        'Do something if the user selects blank - but what??
    End If

    If eName <> "Blank Cells" Then
        For Each hFilterRow In Range("rHFilter").Rows
            Set fName = hFilterRow.Find(what:=eName, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByColumns, _
                                                        SearchDirection:=xlNext, MatchCase:=False)
            If fName Is Nothing Then 'not found
                hFilterRow.EntireRow.Hidden = True
            End If
        Next hFilterRow
    Else
        'Do something if the user selects blank - but what??
    End If

    Set lastCell = Nothing

    If bFilter = False Then
        bFilter = True
        GoTo FilterRowsNCols
    End If

    ' Change the Application settings back
    With Application
        .Calculation = lCalc
        .EnableEvents = True
        .ScreenUpdating = True
    End With

    On Error GoTo 0


    End Sub

    Sub ResetrHFilter()
    On Error Resume Next
    ThisWorkbook.Sheets(1).Columns.Hidden = False
    ThisWorkbook.Sheets(1).Rows.Hidden = False
    SetrHFilterRange
    On Error GoTo 0

    End Sub

==================================

Edit

Added the following edit after reading & testing Scott's answer:

I changed my code from:

strFilter = "-"

For Each c In Range("rHFilter").Cells
    If Application.CountIf(Range(Cells(3, 2), c), c.Value) = 1 Then
        strFilter = strFilter & "," & c.Value
    End If
Next c

With Cells(2, 13).Validation
    .Delete
    .Add Type:=xlValidateList, Formula1:=strFilter & ",Blank Cells"
    .InCellDropdown = True
End With

To this:

strFilter = "-"
Set uniqCol = New Collection

For Each c In Range("rHFilter").Cells
    If Not IsNumeric(c.Value) And Not IsDate(c.Value) Then
       uniqCol.Add c.Value, CStr(c.Value)
    End If
Next c
For Each itmVal In uniqCol
    strFilter = strFilter & "," & itmVal
Next

With Cells(3, 34).Validation
    .Delete
    .Add Type:=xlValidateList, Formula1:=strFilter & ",Blank Cells"
    .InCellDropdown = True
End With

Thank you, Scott

`countif` [counts](https://support.office.com/en-us/article/COUNTIF-function-e0de10c6-f885-4e71-abb4-1f464816df34) the number of occurrences of the second argument in a given range (first argument). — findwindow, Nov 18 '15 at 16:40
Edited out "Duplicates" (in paragraph 3). I understand that `countif`counts the occurences: I'm trying to figure out why it isn't more than one as it goes down the list and gets additional - and how to solve that bit. — JGR, Nov 18 '15 at 16:58
Because of the method that the for each goes the code above will not find only unique. The for each loop move left to right top to bottom. So when it is moving across row 3 it is doing what is wanted but when it drops down to the next row the range it is comparing is B3:B4 not B3:G3 and B4. Thus it will give duplicates. So if your plan is to only get unique values then a collection may be the best method. — Scott Craner, Nov 18 '15 at 17:00
That makes sense - I was wondering if it was something like that, but I couldn't explain it. Thank you. I'll try to work it out with a collection - it just seemed like this was so close and small it was a shame to ditch it. — JGR, Nov 18 '15 at 17:13

Scott Craner · Accepted Answer · 2015-11-18T17:39:34.780

1

Here is a Function that uses Collection to return an Array of unique values.

Function UniqueArray(rng As Range) As Variant()
    Dim cUnique As Collection
    Dim Cell As Range
    Dim vNum As Variant
    Dim tempArr() As Variant
    Dim j As Long

    Set cUnique = New Collection

    On Error Resume Next
        For Each Cell In rng.Cells
            cUnique.Add Cell.Value, CStr(Cell.Value)
        Next Cell
    On Error GoTo 0

    ReDim tempArr(0 To cUnique.Count - 1)
    j = 0
    For Each vNum In cUnique
        tempArr(j) = vNum
        j = j + 1
    Next vNum

    UniqueArray = tempArr
End Function

You would call it like this

Dim tArr as Variant
tArr = UniqueArray("rHFilter")

Then loop through tArr to get your unique values.

edited Nov 18 '15 at 17:39

answered Nov 18 '15 at 17:33

Scott Craner

148,073
10
49
81

Thank you, Scott - I was working on getting a collection to work and came back to see you had added this. I incorporated what you had to make mine a few lines shorter and *ahem* work. :-) This helped: thank you. (I edited mine to show what code I added.) – JGR Nov 18 '15 at 19:47
@JGR Glad I could help. – Scott Craner Nov 18 '15 at 19:55

Excel (macro): understanding code - get unique values (rows & cols) to use in macro

Edit

1 Answers1