merging two column with VBA

[orhanceliloglu]

Hi Everyone,

I need a simple merging code for two tables. But although I checked the forum for 2 hours I couldnt find anything. Since the solution is short thing (I believe), I dont have a code right now sorry.

I attached my excel. So there are 3 columns A B C - and E F G

They have same type of data. The thing i am trying, to merge them into an another 3 column, eg. I J K

It shouldnt delete the duplicates, since I need them. Maybe highlighting the duplicates would be amazing.

If you can just show me a way, I can do the rest.

Many thanks !
Orhan

[LeoTaxi]

Sub test()
Dim mr As Range, i As Long, lr1 As Long, lr2 As Long, lr3 As Long, arr1, arr2
lr1 = Range("A" & Rows.Count).End(xlUp).Row
lr2 = Range("E" & Rows.Count).End(xlUp).Row
lr3 = lr1 + lr2 - 1
arr1 = Range("A2", "D" & lr1)
arr2 = Range("E2", "H" & lr2)
For i = 1 To UBound(arr1)
    arr1(i, 4) = arr1(i, 1) & arr1(i, 2) & arr1(i, 3)
Next
For i = 1 To UBound(arr2)
    arr2(i, 4) = arr2(i, 1) & arr2(i, 2) & arr2(i, 3)
Next
Range("I2").Resize(UBound(arr1), UBound(arr1, 2)) = arr1
Range("I" & lr1 + 1).Resize(UBound(arr2), UBound(arr2, 2)) = arr2
Range("M2", "M" & lr3).FormulaR1C1 = "=countif(C[-1],RC[-1])"
Range("I1", "M" & lr3).AutoFilter 5, Criteria1:=">1"
Set mr = Range("I2", "M" & lr3).SpecialCells(12)
mr.Interior.Color = vbYellow
ActiveSheet.AutoFilterMode = False
Range("L:M").Clear
Range("I:K").Columns.AutoFit
End Sub

Kind regards
Leo

[orhanceliloglu]

Thank you very much Leo, That looks amazing !

Only one thing, you highlighted if there is a same ID and same reason together. But actually, I need to see if there is a same ID even if the reasons are different.

May I kindly ask to adjust the count if for only IDs which is the I column.

maaaany thanks !
Orhan

[daboho]

Sub daboho2()
Dim a, b, c, x, i As Long, temp$, r As Long, j As Long
a = Range("A2", [C30000].End(3)): b = Range("E2", [G30000])
c = Array(a, b)
For i = 0 To UBound(c)
     Range("I8000").End(3).Offset(1).Resize(UBound(c(i), 1), UBound(c(i), 2)).Value = c(i)
Next
Dim d As Object: Set d = CreateObject("scripting.dictionary")
With [i2].CurrentRegion: x = .Value
On Error Resume Next
  For i = 1 To UBound(x)
  temp = x(i, 1) & x(i, 3)
    If Not d.exists(temp) Then
     j = j + 1
     d.Add temp, j
            .Cells(i, 1).Resize(, 3).Interior.ColorIndex = j
    Else
            .Cells(i, 1).Resize(, 3).ColorIndexindex = d(temp)
    End If
  Next i
End With
End Sub

[LeoTaxi]

then looks like this

Sub test()
Dim mr As Range, i As Long, lr1 As Long, lr2 As Long, lr3 As Long, arr1, arr2
lr1 = Range("A" & Rows.Count).End(xlUp).Row
lr2 = Range("E" & Rows.Count).End(xlUp).Row
lr3 = lr1 + lr2 - 1
arr1 = Range("A2", "C" & lr1)
arr2 = Range("E2", "G" & lr2)
Range("I2").Resize(UBound(arr1), UBound(arr1, 2)) = arr1
Range("I" & lr1 + 1).Resize(UBound(arr2), UBound(arr2, 2)) = arr2
Range("L2", "L" & lr3).FormulaR1C1 = "=countif(C[-3],RC[-3])"
Range("I1", "L" & lr3).AutoFilter 4, Criteria1:=">1"
Set mr = Range("I2", "L" & lr3).SpecialCells(12)
mr.Interior.Color = vbYellow
ActiveSheet.AutoFilterMode = False
Range("L:L").Clear
Range("I:K").Columns.AutoFit
End Sub

Kind regards
Leo

[orhanceliloglu]

Worked perfect. Thank you very much Leo !!