CODEWITHSUNDEEP
vba
Jrules80
Jrules80

Reputation: 178

VBA consolidate duplicate values in a delimited array

I have an array like in the picture below. Every entry in the array has three separate values delimited by a semi-colon. There are multiple entries that are duplicates and I want to add all of the last delimited values for those dupes. Let me explain:

enter image description here

So, in the above picture, I want to group all A;1s as A;1;9 and all C;3s as C;3;12

Essentially, the output should look like this:

enter image description here

Here is what my code looks like. sArray1 has the original values (picture 1). I am reducing its size by one because there is a blank value at the end when the array is being dynamically populated. 

ReDim Preserve sArray1(UBound(sArray1) - 1)
ReDim sArray2(0)
k = 0
iArrayIndex = 0
While k < UBound(sArray1)
    While StrComp(Split(sArray1(iArrayIndex), ";")(0), Split(sArray1(iArrayIndex + 1), ";")(0)) = 0 AND StrComp(Split(sArray1(iArrayIndex), ";")(1), Split(sArray1(iArrayIndex + 1), ";")(1)) = 0
        ReDim Preserve sArray2(UBound(sArray2) + 1)
        sArray2(k) = Split(sArray1(iArrayIndex), ";")(0) & ";" & Split(sArray1(iArrayIndex), ";")(1) & ";" & CDbl(Split(sArray1(iArrayIndex), ";")(2)) + CDbl(Split(sArray1(iArrayIndex + 1), ";")(2))
        iArrayIndex = iArrayIndex + 1
        k = k + 1
    Wend
    ReDim Preserve sArray2(UBound(sArray2) + 1)
    iArrayIndex = iArrayIndex + 1
    sArray2(k) = sArray1(iArrayIndex)
    k = k + 1
Wend

UPDATE - @funthomas, here is what the output to your solution looks like:

enter image description here

Upvotes: 0

Views: 75

Answers (1)

FunThomas
FunThomas

Reputation: 29466

I would suggest to use a dictionary for this, with the first 2 parts as key and the 3rd part (the number) as value. 

Dim d As New Dictionary
Dim i As Long
For i = LBound(array1) to UBound(array1) 
    Dim tokens() As String, key, val As Long
    tokens = Split(array1(i), ";")
    key = tokens(0) & ";" & tokens(1)
    val = CLng(tokens(2))

    If d.Exists(key) Then
        d(key) = d(key) + val
    Else
        d.Add key, val
    End If
Next

For Each key In d.Keys()
    Debug.Print key, d(key)
Next

Note that you either need to add a reference to the Microsoft Scripting Runtime or change the code to late binding.

Upvotes: 1

Related Questions