Excel VBA: find the union of two duplicate entries [closed] - excel

Question

Closed. This question needs debugging details. It is not currently accepting answers.
Edit the question to include desired behavior, a specific problem or error, and the shortest code necessary to reproduce the problem. This will help others answer the question.
Closed 7 months ago.
Improve this question
I am new to vba and I've got two updating columns of text & I want to find the union of the two columns.
For Example:
+---------+---------+
| A | B |
| 1 | 1 |
| 1 | 2 |
| 1 | 3 |
| 2 | 4 |
| 3 | 5 |
| 4 | 6 |
| 4 | 7 |
... so on
I want to write the result in a new column A, B, C ...
With column A
number 1, 1 to 3
number 2, 4 to 4 (if not duplicate at value column A)
number 3, 5 to 5
number 4, 6 to 7
like this :
+---------+---------+---------+
| A | B | C |
| 1 | 1 | 3 |
| 2 | 4 | 4 |
| 3 | 5 | 5 |
| 4 | 6 | 7 |
... so on
How to work out this? Thanks in advanced

Answer 1

Please, use the next code. It will return in columns E:F, starting with the second row.
Sub extractMinMax()
Dim sh As Worksheet, lastR As Long, arr, arrIt, arrFin, i As Long, j As Long, dict As New Scripting.Dictionary
Set sh = ActiveSheet 'use here the necessary sheet
lastR = sh.Range("A" & sh.rows.count).End(xlUp).row
arr = sh.Range("A2:B" & lastR).Value2
'place the range in a dictionay:
For i = 1 To UBound(arr)
If Not dict.Exists(arr(i, 1)) Then
dict.Add arr(i, 1), Array(arr(i, 2))
Else
arrIt = dict(arr(i, 1))
ReDim Preserve arrIt(UBound(arrIt) + 1)
arrIt(UBound(arrIt)) = arr(i, 2)
dict(arr(i, 1)) = arrIt
End If
Next i
'process the dictionary content
ReDim arrFin(1 To dict.count, 1 To 3)
For i = 0 To dict.count - 1
arrFin(i + 1, 1) = dict.Keys()(i)
arrFin(i + 1, 2) = WorksheetFunction.min(dict.Items()(i))
arrFin(i + 1, 3) = WorksheetFunction.Max(dict.Items()(i))
Next i
'drop the processed array content:
sh.Range("E2").Resize(UBound(arrFin), UBound(arrFin, 2)).Value2 = arrFin
End Sub