VBA filter for unique numbers (filter out text)

[xargon05]

Hi Folks,

I'm trying to create a vba filter to copy all unique numbers from a column that contains some cells with text (ex. ID Crew 3), others with numbers. (ex. 61008677), and paste the result in another worksheet.

Here's my current code to get unique values. I still haven't figured out how to filter the list for numbers. I hit a lot of errors trying to do x1FilterCopy, so my best result here is just an edited recorded macro

POHistory is a named list going from T2 to the end of the data in the column

Sub CopyUniquePOs()'
' CopyUniquePOs Macro
'
    Range("POHistory").AdvancedFilter Action:=xlFilterInPlace, Unique:=True
    
    Sheets("Order History").Select
    Range("T3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    
    Sheets("PO Totals").Select
    Range("A2").Select
    ActiveSheet.Paste
    Sheets("Order History").ShowAllData
    
End Sub

 

[igold]

This does not use a filter but I think if fulfills your requirements...

Sub CopyUniquePOs()


    Dim arr
    Dim x As Long, lrow As Long
    
    With Worksheets("Order History")
        lrow = .Cells(Rows.Count, 20).End(xlUp).Row
        arr = .Range("T3:T" & lrow)
    End With
    With CreateObject("Scripting.Dictionary")
        For x = LBound(arr) To UBound(arr)
            If IsNumeric(arr(x, 1)) Then
                If Not IsMissing(arr(x, 1)) Then .Item(arr(x, 1)) = 1
            End If
        Next
        Worksheets("PO Totals").Range("A2").Resize(.Count) = Application.Transpose(.keys)
    End With
    
End Sub

 

[xargon05]

Igold - I'm not even sure what all is going on there, but it works perfectly! Thank you!

Maybe just for my own benefit and anyone else who comes across this post, could you give me a brief description of what's going on here?

 

[igold]

You're welcome. I am glad it worked for you.

Basically the code takes your list and puts it in an array. It then looks at each element of the array and if the element is not a number it skips it, but if it is a number, the code uses the dictionary object to create a list of the unique numbers.

After that it copies that unique list to your output sheet.

Sub CopyUniquePOs()


    Dim arr
    Dim x As Long, lrow As Long
    
'   Find the last row and put your PO list into the array named "arr"
    With Worksheets("Order History")
        lrow = .Cells(Rows.Count, 20).End(xlUp).Row
        arr = .Range("T3:T" & lrow)
    End With
    
'   Using the Dictionary object loop through each element of "arr"


    With CreateObject("Scripting.Dictionary")
        For x = LBound(arr) To UBound(arr)
            If IsNumeric(arr(x, 1)) Then  'If the element is a number then with the dictionary create a unique list
                If Not IsMissing(arr(x, 1)) Then .Item(arr(x, 1)) = 1
            End If
        Next
        
'   Paste the unique dictionary collection to your desired location using properties of the dictionary.
        Worksheets("PO Totals").Range("A2").Resize(.Count) = Application.Transpose(.keys)
    End With
    
End Sub