Compare - Help me modify script

[emukiss10]

Hi,

I would like to look for contents of cells in column A Sheet 1 and compare it to contents in Sheet 2.

If it can be found (ex. A6 sheet 1 was found in A99 sheet 2) than I want to compare column C in both sheets. If its not match - remove row in sheet 2.

my code to compare and remove unique values from Sheet 2

   Dim Cl As Range
   Dim Rng As Range
   
   With CreateObject("scripting.dictionary")
      For Each Cl In Sheets(1).Range("A2", Sheets(1).Range("A" & Rows.Count).End(xlUp))
         If Not .Exists(Cl.Value) Then .Add Cl.Value, Nothing
      Next Cl
      For Each Cl In Sheets(2).Range("A2", Sheets(2).Range("A" & Rows.Count).End(xlUp))
         If Not .Exists(Cl.Value) Then
            If Rng Is Nothing Then
               Set Rng = Cl
            Else
               Set Rng = Union(Rng, Cl)
            End If
         End If
      Next Cl
   End With
   If Not Rng Is Nothing Then Rng.EntireRow.Delete

Id like it to "IF" value is found check column C if it is a match too.


Best regards
w.

 

[emukiss10]

Happy new Year!

Fluff, Your code works fine. I have a question. Can it be changed to Highlight cells that are different to another colour? The whole row is marked by RGB(172, 153, 207), but I would like to know exactly what value was different.

Can You help with that?

 Dim Xl As Range
   Dim RngX As Range
   Dim ValU As String
   
   With CreateObject("scripting.dictionary")
      For Each Xl In Sheets(1).Range("A2", Sheets(1).Range("A" & Rows.Count).End(xlUp))
         ValU = Xl.Value & Xl.Offset(, 2).Value & Xl.Offset(, 6).Value & Xl.Offset(, 7).Value & Xl.Offset(, 9).Value & Xl.Offset(, 10).Value & Xl.Offset(, 12).Value
         If Not .Exists(ValU) Then .Add ValU, Nothing
      Next Xl
      For Each Xl In Sheets(2).Range("A2", Sheets(2).Range("A" & Rows.Count).End(xlUp))
         ValU = Xl.Value & Xl.Offset(, 2).Value & Xl.Offset(, 5).Value & Xl.Offset(, 6).Value & Xl.Offset(, 8).Value & Xl.Offset(, 10).Value & Xl.Offset(, 12).Value
         If Not .Exists(ValU) Then
           Xl.Resize(, 15).Interior.Color = RGB(172, 153, 207)
         End If
      Next Xl
   End With

Best Regards!
W.

 

[Fluff]

Do any columns contain a unique ID of some sort?

 

[emukiss10]

Every column has a name but in both sheets the names do not match

 

[Fluff]

One option is to use 7 levels of nested dictionaries, which is well beyond my ken.
To figure out other options I'd need to see a sample of your data.
Therefore could you please supply some sample data. Tools to help with that can be found here
https://www.mrexcel.com/forum/about-board/508133-attachments.html

 

[emukiss10]

Unfortunetly I can go to jail for that I cannot show anything.. It is not my personal project but work. Cannot send anything either.

 

[Fluff]

In order to find out which fields are different, we'll need some way to identify, which records to look at. That is compare (for instance) row 1 on sheet 1 with row 35 on sheet 2. How can we do that?

 

[emukiss10]

Fluff, Ive come with different approach. Can You modify this to colour only one cell from offset (, 2)? I've broke this code in to several other "smaller" codes but I have better control this way.

Can I colour only "X1.Offset(, 12).Value" ? - I mean only one cell in column 12? one with difference.

With CreateObject("scripting.dictionary")
      For Each Xl In Sheets(1).Range("A2", Sheets(1).Range("A" & Rows.Count).End(xlUp))
         ValU = Xl.Value & Xl.Offset(, 12).Value
         If Not .Exists(ValU) Then .Add ValU, Nothing
      Next Xl
      For Each Xl In Sheets(2).Range("A2", Sheets(2).Range("A" & Rows.Count).End(xlUp))
         ValU = Xl.Value & Xl.Offset(, 12).Value
         If Not .Exists(ValU) Then
           Xl.Resize(, 12).Interior.Color = RGB(230, 130, 130)
         End If
      Next Xl
   End With

 

[emukiss10]

OK, Ive managed to work it out.

Ive splited the code that checked many cells in to 7 smaller codes and change output to

Xl.Offset(, 12).Interior.Color = RGB(230, 130, 130)

that it colour only cells that are different. Thanks Fluff!

 

[emukiss10]

Next step in comparing - this I must do with my own eyes but with Excel help.

Probably based on our (Fluff's) code :

   With CreateObject("scripting.dictionary")
      For Each Xl In Sheets(1).Range("A2", Sheets(1).Range("A" & Rows.Count).End(xlUp))
         ValU = Xl.Value 
         If Not .Exists(ValU) Then .Add ValU, Nothing
      Next Xl
      For Each Xl In Sheets(2).Range("A2", Sheets(2).Range("A" & Rows.Count).End(xlUp))
         ValU = Xl.Value 
         If Not .Exists(ValU) Then
  
   [B]    "Some logic..."[/B]


         End If
      Next Xl
   End With

I would like excel to:

1. Compare column A Sheets(1) like in previous code to column A Sheets(2)
2. If match copy cell from column "I" (i) Sheets(1)
3. Paste that value to column H Sheets(2)
- ofc to according row - if Sheets(2) A2 Match is found in Sheets(1) A88 - value from column I row 88 Sheets(1) should be copied to Row 2 column H Sheets(2)

 

[Fluff]

Try

   Dim Xl As Range

   With CreateObject("scripting.dictionary")
      For Each Xl In Sheets(1).Range("A2", Sheets(1).Range("A" & Rows.Count).End(xlUp))
         If Not .Exists(Xl.Value) Then .Add Xl.Value, Xl.Offset(, 8).Value
      Next Xl
      For Each Xl In Sheets(2).Range("A2", Sheets(2).Range("A" & Rows.Count).End(xlUp))
         If .Exists(Xl.Value) Then Xl.Offset(, 7).Value = .Item(Xl.Value)
        Next Xl
   End With