简体   繁体   中英

VBA - Getting unique values from dynamic range

I used eksortso's answer from vba: get unique values from array to get unique values from an array

Sub Trial()
    Dim myArray() As Variant
    Dim i As Long
    Dim d As Object

    myArray() = Array("Banana", "Apple", "Orange", "Tomato", "Apple", "Lemon", "Lime", "Lime", "Apple")

    Set d = CreateObject("Scripting.Dictionary")

    For i = LBound(myArray) To UBound(myArray)
        d(myArray(i)) = 1
    Next i

End Sub

This works perfectly but when I try to apply this to a range read off a worksheet, it gives me an error - Run-time error '9': Subscript out of range

Sub Clients()

    Dim Sht As Worksheet
    Dim LastRow As Long
    Dim StartCell As Range
    Dim ClientType As Variant
    Dim UniqueType As Object
    Dim i As Long

    Set Sht = Worksheets("ALL CLIENTS")
    Set StartCell = Range("F6")

    'Find Last Row
    LastRow = Sht.Cells(Sht.Rows.Count, StartCell.Column).End(xlUp).Row

    'Read Client Type Column
    ClientType = Sht.Range(StartCell, Sht.Cells(LastRow, StartCell.Column))

    Set UniqueType = CreateObject("Scripting.Dictionary")

    For i = (LBound(ClientType) - 1) To UBound(ClientType)
        UniqueType(ClientType(i)) = 1
    Next i

End Sub

Is this happening because myArray is starting at subscript 0 while ClientType is starting at 1 ? How do I fix this?

Yes ClientType will be 1-based.

Drop that -1 , and also remember you're working with a 2D array:

For i = LBound(ClientType, 1) To UBound(ClientType, 1)
    UniqueType(ClientType(i, 1)) = 1
Next i

Possible failure mode when there's only a single cell in the list, since in that case you will not get a 2-D array in ClientType

在此处输入图片说明

Sub UniqueVal2Range()
    Dim Arr As New Collection, a
    Dim Item As Variant
    Dim vRng As Range

    Lr = Sheet1.Cells(Rows.Count, "A").End(xlUp).Row    'Range Last Row
    Set vRng = Sheet1.Range("A2:A" & Lr)

    If vRng.Count > 0 Then
    '---Making Unique Values
        On Error Resume Next
            For Each a In vRng
               Arr.Add a, a
            Next
        On Error GoTo 0

    '---Printing Unique Values
        For Each Item In Arr
            Debug.Print Item
        Next Item
    End If
End Sub

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM