Compare two columns and add missing string + value to two different columns vba

[Qizi]

Hey you!

I was trying to tweak the code provided by mumps in this thread: Find missing values between two columns with VBA

With 0 success and I'm super desperate, however, I need to have this solved today in order to go to bed peacefully.

The workbook is used to have an overview of Product availability. If a new Product is added to Table2 Column B, I would like to have a macro that does check, if the product or products already exists in Table1 Column B.
If the Product is not found in Table1 Column B, add Product Name from Table2 Column B AND (this is the part I'm struggling with) Units from Table2 Column C to:
Product Name: From Table2 Column B to Table1 Column B after the last entry
Units: From Table2 Column C to Table 1 Column F in the same row

Pleeeeeease, help me

Thank you!!!

 

[Qizi]

Hey,

I was able to come up with a code that nearly does the trick. At least I was able to split the Dictionary Key and Item to paste it into different columns.
If I want to print my dictionary into rows, it is repeating the first dictionary line over and over again.
However, if I'm printing it to columns, it works.

Do someone of you has an idea how to solve this?

Sub check()

Sub check()

Dim Tab1 As Variant, Tab2 As Variant
Dim PasteRows As Long
Dim r As Long

PasteRows = Sheets("Tabelle2").Cells(Rows.Count, 1).End(xlUp).Row

With Worksheets("Tabelle1")
    Tab1 = .Range("A2:B" & .Range("A" & .Rows.Count).End(xlUp).Row).Value2
End With

With Worksheets("Tabelle2")
    Tab2 = .Range("A2", .Range("A" & Rows.Count).End(xlUp)).Value2
End With

With CreateObject("Scripting.Dictionary")
    For r = 1 To UBound(Tab1)
        If Not .Exists(Tab1(r, 1)) Then
            .Add Key:=Tab1(r, 1), Item:=Tab1(r, 2)
        End If
    Next r
    For r = 1 To UBound(Tab2)
        If .Exists(Tab2(r, 1)) Then
            .Remove Tab2(r, 1)
        End If
    Next r
      
'This part of Code will print the Dictionary to rows, but will only repeat my first line of the created Dictionary and repeats the first Key
        Sheets("Tabelle2").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Resize(.Count, 1).Value2 = .Keys
        Sheets("Tabelle2").Range("C" & Rows.Count).End(xlUp).Offset(1, 0).Resize(.Count, 1).Value2 = .Items
'This part of Code will print the Dictionary to columns with the exact missing elements out of the Dictionary..

        
        Sheets("Tabelle2").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Resize(, .Count).Value2 = .Keys
        Sheets("Tabelle2").Range("C" & Rows.Count).End(xlUp).Offset(1, 0).Resize(, .Count).Value2 = .Items

End With
End Sub


End With
End Sub

Help

 

[Qizi]

Solution found, have fun all:

Sub Copy_Products()

Dim Tab1 As Variant, Tab2 As Variant
Dim r As Long
Dim i As Long

With Worksheets("Tabelle2")
    Tab1 = .Range("B2:C" & .Range("B" & .Rows.Count).End(xlUp).Row).Value2
End With

With Worksheets("Tabelle1")
    Tab2 = .Range("B10", .Range("A" & Rows.Count).End(xlUp)).Value2
End With

With CreateObject("Scripting.Dictionary")
    For r = 1 To UBound(Tab1)
        If Tab1(r, 2) = "" Then
            Tab1(r, 2) = 0
        End If
        
        If Not .Exists(Tab1(r, 1)) Then
            .Add Key:=Tab1(r, 1), Item:=Tab1(r, 2)
        End If
    Next r
    For r = 1 To UBound(Tab2)
        If .Exists(Tab2(r, 1)) Then
            .Remove Tab2(r, 1)
        End If
    Next r
    
    For i = 0 To .Count - 1
    Sheets("Tabelle1").Range("B" & Rows.Count).End(xlUp).Offset(1, 0).Value = .Keys()(i)
    Sheets("Tabelle1").Range("F" & Rows.Count).End(xlUp).Offset(1, 0).Value = .Items()(i)
    Next i

End With
End Sub