CODEWITHSUNDEEP
vbaexcel
user2284877
user2284877

Reputation: 138

VBA Output new collection to single cell

I need to get unique values from a range, in a specific cell.
A1=x, A2=y, A3=z, A4=x
I want to get B1=x,y,z
My solution is:
concatenate A1,A2,A3,A4, in B2.
split B2.
make new collection from splitted B2.
output collection elements into C1, C2, ..Ci
concatenate C1, C2,..Ci into B1

Is possible to avoid to output collection into C1,C2 ? but output directly into B1 through some variable ? 

   '''''''  
concatenation part    
''''''''
    Dim ary As Variant
    Dim Arr As New Collection, a
    Dim i As Long
    ary = split(Range("b2"), ",")

    For Each a In ary
    Arr.Add a, a
    Next

    For i = 1 To Arr.count
    Cells(1, i+2) = Arr(i) ' output collection in some cells
    Next
    '''''''''''''''''''''''''
concatenation part
'''''''''''

Thank you.

Upvotes: 0

Views: 901

Answers (4)

Gary's Student
Gary's Student

Reputation: 96791

Perhaps:

Public Function KonKat(rng As Range) As String
    Dim c As Collection, r As Range, i As Long

    Set c = New Collection
    On Error Resume Next
        For Each r In rng
            c.Add r.Value, CStr(r.Value)
        Next r
    On Error GoTo 0

    For i = 1 To c.Count
        KonKat = KonKat & "," & c.Item(i)
    Next i
        KonKat = Mid(KonKat, 2)
End Function

enter image description here

Upvotes: 0

user3598756
user3598756

Reputation: 29421

you could use a late binding "on the fly" Dictionary object:

Sub main()
    Dim cell As Range

    With CreateObject("Scripting.Dictionary")
        For Each cell In Range("A1:A4") '<--| change "A1:A4" to whatever range you need
            .Item(cell.Value) = .Item(cell.Value) + 1
        Next cell
        Range("B1").Value = Join(.keys, ",")
    End With
End Sub

Upvotes: 2

CommonSense
CommonSense

Reputation: 4482

If you need to hold something unique - always think about dictionary, cause of Exists method. Here's a small example:

Sub test()
    Dim NonUniqueValues As Variant
    Dim UniqueValues As Object
    Dim i As Long

    'gather source array
    NonUniqueValues = Union([A1], [A2], [A3], [A4]).Value2

    'set dict
    Set UniqueValues = CreateObject("Scripting.Dictionary")

    'loop over array
    For i = LBound(NonUniqueValues, 1) To UBound(NonUniqueValues, 1)
        If Not UniqueValues.Exists(NonUniqueValues(i, 1)) Then _
                Call UniqueValues.Add(Key:=NonUniqueValues(i, 1), Item:=NonUniqueValues(i, 1))
    Next

    'output
    [B1] = Join(UniqueValues.Keys, ",")

End Sub

enter image description here

Upvotes: 0

Nathan_Sav
Nathan_Sav

Reputation: 8531

in the array, split again, spit(a,"=") adding index 1 to another array, not a collection, then use JOIN to put it back together

x=0
redim arrOutput(ubound(ary))
For Each a In ary
    arrOutput(x)= split(a,"=")(1)
    x=x+1
Next

range("b1")=join(arrOutput,",")

or just split by = and take odd numbers from the resulting array maybe?

Upvotes: 0

Related Questions