Match VBA Array values and overwrite duplicates

Question

Welcome!

I have problem with preparing function or part of the code which provides operation on data in structure below (data in this format is already stored in Array):

ID Flag Company
33 AB   67345
33 ABC  53245
33 C    67345
33 AB   25897
33 A    89217
33 BC   81237
33 B    89217
33 C    89217

The purpose of the exercise is to obtain new array with combined records based on the key ID + Company. So basically output should be:

33 ABC  67345
33 ABC  53245
33 AB   25897
33 ABC  89217
33 BC   81237

I have tried several solution but still not getting final result. I used loops or comparing methods.

Can anyone provide vital solution? Performance is not a key at this point, the most important is solution that will solve this problem.

I have tried solution with moving values from Array to another but still I get duplicated rows for example:

33 ABC 89217
33 AB  89217
33 C   89217

Example of the code:

   For i = 1 To UBound(Array1)
        If Array1(i, 13) <> "Matched" Then
            strTestCase = Array1(i, 1) & Array1(i, 9)
            strLegalEntityType = EntityFlag(Array1(i, 5))
                For j = 1 To UBound(Array1)
                            If Array1(j, 1) & Array1(j, 9) = strTestCase Then
                                    Array1(i, 13) = "Matched"
                            End If

                            If EntityFlag(Array1(i, 5)) = EntityFlag(Array1(j, 5)) Then
                                arrTemporary1(i, 5) = EntityFlag(Array1(j, 5)) & strLegalEntityType
                                arrTemporary1(i, 5) = funcRemoveDuplicates(arrTemporary1(i, 5))
                                 arrTemporary1(i, 1) = Array1(i, 1)
                                 arrTemporary1(i, 2) = Array1(i, 2)
                                 arrTemporary1(i, 3) = Array1(i, 3)
                                 arrTemporary1(i, 4) = Array1(i, 4)
                                 arrTemporary1(i, 6) = Array1(i, 6)
                                 arrTemporary1(i, 7) = Array1(i, 7)
                                 arrTemporary1(i, 8) = Array1(i, 8)
                                 arrTemporary1(i, 9) = Array1(i, 9)
                                 arrTemporary1(i, 10) = Array1(i, 10)
                                 arrTemporary1(i, 11) = Array1(i, 11)
                                 arrTemporary1(i, 12) = Array1(i, 12)

                                 a = a + 1

                             End If


            Next j
        End If
    Next i

Can you include the relevant piece of code you have tried so far? — JvdV
– JvdV, Commented May 23, 2019 at 9:50
I post code in the post - sorry for trouble but this is my first attempt with stack :) — mikemorrison
– mikemorrison, Commented May 23, 2019 at 10:10

Ron Rosenfeld · Accepted Answer · 2019-05-23 10:14:35Z

2

This can be done in Power Query (aka Get&Transform in Excel 2016+)

Group the Rows by ID and Company with Operation = "All Rows"
Add a custom column to change the resultant table into a list:
- Formula for custom column: Table.Column([Grouped],"Flag")
Select the double headed arrow at the top of the "Custom" column and"Extract" values from the list with "none" for the delimiter

The above can all be done from the user interface, (with manual entry of the formula for the custom column), but here is the resultant M-Code:

let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    #"Changed Type" = Table.TransformColumnTypes(Source,{{"ID", Int64.Type}, {"Flag", type text}, {"Company", Int64.Type}}),
    #"Grouped Rows" = Table.Group(#"Changed Type", {"ID", "Company"}, {{"Grouped", each _, type table [ID=number, Flag=text, Company=number]}}),
    #"Added Custom" = Table.AddColumn(#"Grouped Rows", "Custom", each Table.Column([Grouped],"Flag")),
    #"Extracted Values" = Table.TransformColumns(#"Added Custom", {"Custom", each Text.Combine(List.Transform(_, Text.From)), type text})
in
    #"Extracted Values"

answered May 23, 2019 at 10:14

Ron Rosenfeld

62k7 gold badges35 silver badges71 bronze badges

Sign up to request clarification or add additional context in comments.

2 Comments

mikemorrison Over a year ago

Thank you for solution - Unfortunately I'm working on Excel 2010, that is why it is impossible to implement this solution. Anyway I will test it on my own computer to see how it is works.

Ron Rosenfeld Over a year ago

@mikemorrison For Excel 2010, Power Query is available as a free add-in supplied by Microsoft.

Tom · Accepted Answer · 2019-05-23 12:21:17Z

0

You can achieve this by using a dictionary. To use dictionaries you will need to add a reference to Microsoft Scripting Runtime

Sub demo()
    Dim dict As New Scripting.Dictionary
    Dim arr As Variant
    Dim i As Long
    Dim tmpID As String
    Dim k
    Dim tmpFlag As String

    ' Set range to variant
    ' Update with your sheet reference and range location
    With ActiveSheet
        arr = .Range(.Cells(2, 1), .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, 3))
    End With

    ' Loop through array
    For i = LBound(arr, 1) To UBound(arr, 1)
        ' Create composite ID of ID and Company
        tmpID = arr(i, 1) & "," & arr(i, 3)
        ' If it doesn't exist add to dictionary
        If Not dict.Exists(tmpID) Then
            dict.Add Key:=tmpID, Item:=arr(i, 2)
        ' If it does exist append value
        Else
            tmpFlag = StrConv(dict(tmpID) & arr(i, 2), vbUnicode)
            tmpFlag = Join(SortArrayAtoZ(Split(tmpFlag, Chr$(0), Len(tmpFlag))), "")
            dict(tmpID) = tmpFlag
        End If
    Next i

    ' Read back results
    ReDim arr(1 To dict.Count, 1 To 3)
    Dim arrCount As Long

    ' Debug.Print results can be viewed in the Immediate Window
    Debug.Print "ID", "Flag", "Company"
    For Each k In dict.Keys
        arrCount = arrCount + 1
        arr(arrCount, 1) = Split(k, ",")(0)
        arr(arrCount, 2) = dict(k)
        arr(arrCount, 3) = Split(k, ",")(1)
        Debug.Print Split(k, ",")(0), dict(k), Split(k, ",")(1)
    Next k

    ' Update with first cell of desired location of results
    With ActiveSheet
        .Cells(2, 5).Resize(UBound(arr, 1), UBound(arr, 2)) = arr
    End With

End Sub

Function SortArrayAtoZ(myArray As Variant)
    Dim i As Long
    Dim j As Long
    Dim Temp

    'Sort the Array A-Z
    For i = LBound(myArray) To UBound(myArray) - 1
        For j = i + 1 To UBound(myArray)
            If UCase(myArray(i)) > UCase(myArray(j)) Then
                Temp = myArray(j)
                myArray(j) = myArray(i)
                myArray(i) = Temp
            End If
        Next j
    Next i

    SortArrayAtoZ = myArray
End Function

edited May 23, 2019 at 12:21

answered May 23, 2019 at 10:14

Tom

9,9184 gold badges34 silver badges51 bronze badges

2 Comments

mikemorrison Over a year ago

It is working very well! My original array has more fields so I modify this - it seems producing results correctly. One additional questions - is there any way to sort flags after consolidation? I mean how to avoid case when I have CAB instead of ABC

Tom Over a year ago

@mikemorrison You can use a sort function to order the results. Have updated my answer

Collectives™ on Stack Overflow

Match VBA Array values and overwrite duplicates

2 Answers 2

2 Comments

2 Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

2 Answers 2

2 Comments

2 Comments

Your Answer

Sign up or log in

Post as a guest

Related