Match VBA Array values and overwrite duplicates - arrays

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

Answer 1

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"

Answer 2

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