I'm trying to accomplish the following.
So given the following table...
I'd like to filter for "One" in column A and get an array back that I can paste unto column C like this...
I've tried to use dictionaries but I have little understanding of how that works. There can be thousands of rows so speed can be an issue and I'd rather not loop through each if it's not necessary.
I've seen solutions that bring back unique values of a column using advanced filter but never a combination of filtering one column and then using the filtered results to get a unique list of values.
Example of code (partial) I've tried:
On Error Resume Next
enterpriseReportSht.ShowAllData
On Error GoTo 0
With enterpriseReportSht
.AutoFilterMode = False
With .Range(Cells(1, 1).Address, Cells(entRptLR, entRptLC).Address)
.AutoFilter Field:=manLevel2CN, Criteria1:=userInputsArr(i, manLevel2InputCN)
'.SpecialCells(xlCellTypeVisible).Copy Destination:=resultsSht.Range("A1")
End With
End With
filteredColArr = enterpriseReportSht.UsedRange.columns(manLevel4CN).Value
RemoveDuplicatesFromArray (filteredColArr)
with this function:
Public Function RemoveDuplicatesFromArray(sourceArray As Variant)
Dim duplicateFound As Boolean
Dim arrayIndex As Integer, i As Integer, j As Integer
Dim deduplicatedArray() As Variant
arrayIndex = -1
deduplicatedArray = Array(1)
For i = LBound(sourceArray) To UBound(sourceArray)
duplicateFound = False
For j = LBound(deduplicatedArray) To UBound(deduplicatedArray)
If sourceArray(i) = deduplicatedArray(j) Then
duplicateFound = True
Exit For
End If
Next j
If duplicateFound = False Then
arrayIndex = arrayIndex + 1
ReDim Preserve deduplicatedArray(arrayIndex)
deduplicatedArray(arrayIndex) = sourceArray(i)
End If
Next i
RemoveDuplicatesFromArray = deduplicatedArray
End Function
My concerns with it is that it's not grabbing the filtered data. It's grabbing all of it I believe. I'm also getting an error with the remove duplicates function.
This should do what you are looking for using a dictionary.
You could speed it up by loading the range into an array and iterating through that, but it's a bit of a pain to do that with a filtered range as well as getting the upperbound of a two dimensional array, you'll need to transpose it into a one dimensional array first. Probably not worth it unless you notice the speed is really slow. I tested with 15k rows it was < 1 second.
Dim i As Long
Dim lr As Long
Dim filterrange As Range
Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")
With Sheet1 'Change as needed
lr = .Cells(.Rows.Count, 1).End(xlUp).Row
Set filterrange = .Range(.Cells(1, 1), .Cells(lr, 2))
filterrange.AutoFilter 1, "One"
lr = .Cells(.Rows.Count, 1).End(xlUp).Row 'Only really necessary if you have a lot of rows
For i = 1 To lr
If .Rows(i).EntireRow.Hidden = False Then
If Not dict.exists(.Cells(i, 2).Value) Then
dict.Add .Cells(i, 2).Value, ""
End If
End If
Next i
filterrange.AutoFilter
Dim key As Variant
i = 1
For Each key In dict
.Cells(i, 3).Value = key
i = i + 1
Next key
End With