Compare two sheets and copy values

[micrdy]

Hi!
First of all: great forum. Had found so much nice posts here. But now I got a problem I can´t find a solution to.
I got two sheets:

Sheet1
[TABLE="class: outer_border, width: 500"]
<tbody>[TR]
[TD]ID[/TD]
[TD]Name[/TD]
[TD]Cat1[/TD]
[TD]Cat2[/TD]
[TD]Cat3[/TD]
[/TR]
[TR]
[TD]xt-12345[/TD]
[TD]Product 1[/TD]
[TD]LED[/TD]
[TD]Lights[/TD]
[TD]Panels[/TD]
[/TR]
[TR]
[TD]xt-54321[/TD]
[TD]Product 2[/TD]
[TD]LED[/TD]
[TD]Lights[/TD]
[TD]Downlight[/TD]
[/TR]
</tbody>[/TABLE]

Sheet2
[TABLE="class: outer_border, width: 500"]
<tbody>[TR]
[TD]ID[/TD]
[TD]Name[/TD]
[TD]Cat1[/TD]
[TD]Cat2[/TD]
[TD]Cat3[/TD]
[/TR]
[TR]
[TD]xt-12345[/TD]
[TD]Product 1[/TD]
[TD]xxx[/TD]
[TD]xxx[/TD]
[TD]xxx[/TD]
[/TR]
[TR]
[TD]xt-54321[/TD]
[TD]Product 2[/TD]
[TD]xxx[/TD]
[TD]xxx[/TD]
[TD]xxx[/TD]
[/TR]
</tbody>[/TABLE]

What I want to achieve is this:
I got a supplier for an online shop. He got about 1000 products. This products are changing frequently so i need to update them every week. I got my own categories for the products so every time I update the products I need to know which products are new and which products are old.

I need to compare the IDs in Sheet1 and Sheet2 (there is another sort-order, so I need to compare the whole column) and if e.g. the product with the ID xt-12345 is present in both sheets, the matching values of columns cat1, cat2, cat3 should be copied from sheet1 to sheet2. So sheet two looks like this:

Sheet2
[TABLE="class: outer_border, width: 500"]
<tbody>[TR]
[TD]ID[/TD]
[TD]Name[/TD]
[TD]Cat1[/TD]
[TD]Cat2[/TD]
[TD]Cat3[/TD]
[/TR]
[TR]
[TD]xt-12345[/TD]
[TD]Product 1[/TD]
[TD]LED[/TD]
[TD]Lights[/TD]
[TD]Panels[/TD]
[/TR]
[TR]
[TD]xt-54321[/TD]
[TD]Product 2[/TD]
[TD]LED[/TD]
[TD]Lights[/TD]
[TD]Downight[/TD]
[/TR]
</tbody>[/TABLE]


Another important thing: The macro should highlight the products in sheet2, which are present in sheet2 but not in sheet1.

Well, I know this is kind of complicated, but I hope anyone here could point me in the right direction to solve this.

Thanks in advance!
Cheers,
micrdy

 

[micrdy]

This code (after you have selected ID column of both sheets) highlights the new products. I already got that match. So I just need to copy the matching values from column cat, cat2 and cat3 to sheet2... (have marked that line with a comment in code)

Sub Compare()
Dim Range1 As Range, Range2 As Range, Rng1 As Range, Rng2 As Range, outRng As Range
xTitleId = "licht-shop24.com Lieferanten Vergleich"
Set Range1 = Application.Selection
Set Range1 = Application.InputBox("Spalte mit Artikelnummern der neuen Liste :", xTitleId, Range1.Address, Type:=8)
Set Range2 = Application.InputBox("Spalte mit Artikelnummern der alten Liste:", xTitleId, Type:=8)
Application.ScreenUpdating = False
For Each Rng1 In Range1
    xValue = Rng1.Value
    For Each Rng2 In Range2
        If xValue = Rng2.Value Then
            If outRng Is Nothing Then
                ' If the product is new -> highlight ID
                Set outRng = Application.Union(outRng, Rng1)
            Else
                ' If the product is not a new product -> copy cat1, cat2, cat3 from sheet1 to sheet
                ' need help HERE
                Set outRng = Rng1
            End If
        End If
    Next
Next
outRng.Interior.ColorIndex = 37
Application.ScreenUpdating = True
End Sub

on the HERE comment should be this behaviour:
- get the values of the columns cat1, cat2, cat3 from the matching product in sheet1
- paste them to to sheet2 to the matching product

Any help would be amazing

 

[micrdy]

Sub Compare()
Dim Range1 As Range, Range2 As Range, Rng1 As Range, Rng2 As Range, outRng As Range
Dim Id As String
xTitleId = "licht-shop24.com Lieferanten Vergleich"
Set Range1 = Application.Selection
Set Range1 = Application.InputBox("Spalte mit Artikelnummern der neuen Liste :", xTitleId, Range1.Address, Type:=8)
Set Range2 = Application.InputBox("Spalte mit Artikelnummern der alten Liste:", xTitleId, Type:=8)
Application.ScreenUpdating = False
For Each Rng1 In Range1
    xValue = Rng1.Value
    For Each Rng2 In Range2
        If xValue = Rng2.Value Then
            If outRng Is Nothing Then
                Set outRng = Rng1
            Else
                Set outRng = Application.Union(outRng, Rng1)
                Cells(Rng1.Row, 7).Value = Cells(Rng2.Row, 7).Value
                Id = Cells(Rng1.Row, 7).Value
                Cells(Rng1.Row, 7).Value = Cells(Id, 7).Value
            End If
            
        End If
    Next
Next
outRng.Interior.ColorIndex = 37
Application.ScreenUpdating = True
End Sub

This code now gives me the coresponding row indexes from sheet1 to sheet2. But how to get the values from sheet1?