(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
==================================
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
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.