Refacor my code please

[emukiss10]

hello, I need to temper this code a little (code made by Fluff)

   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(, 5).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(, 16).Value
         If Not .Exists(ValU) Then
           Xl.Offset(, 0).Interior.Color = RGB(157, 157, 157)
           Xl.Offset(, 1).Interior.Color = RGB(230, 130, 130)
         End If
      Next Xl
   End With

it compare values 1 to 1 from different sheets based on column A1.

In offset(0,5) sheet 1 and offset(0,16) sheet 2 it compares values and it works great but I need a little change.

everything should be 1:1 but if in Sheet 1 value that is currently checked is 14 and sheet 2 value is 12 it should be ignored (as correct - just like 1:1 match) any other result than this or 1:1 match should be noted (in this case by colour).

Can You make this work?

best regards!
W.

 

[StephenCrump]

Your code colours cells in columns A and B of Sheets(2) if the concatenated value of columns A and Q doesn't occur anywhere in the concatenated values of columns A and F in Sheets(1).

What do you mean exactly when you say "sheet2 value is 12"? Are you perhaps saying that if the column A value is 12 you don't want to colour the cells? Or is this perhaps the column Q value?

And what do you mean by "Sheet 1 value that is currently checked is 14"? There is no 1:1 comparison happening in the code.

 

[emukiss10]

Ill try to explain

This code is looking for the same values in both sheets. If values does not match it is alter the color of that cells.
I would like to make a little change. IF values do not match - change color - except value 14 sheet 1 and value 12 sheet 2 - This should not be marked.

values Ex.

Sheet1 - 10, Sheet2 - 10 | ok
Sheet1 - 14, Sheet2 - 12 | ok
Sheet1 - 12, Sheet2 - 14 | NOT OK
Sheet1 - 2, Sheet2 - 2 | ok
Sheet1 - 55, Sheet2 - 54 | NOT OK
Sheet1 - 23, Sheet2 - 22 | NOT OK
Sheet1 - 88, Sheet2 - 88 | ok
Sheet1 - 14, Sheet2 - 12 | ok
Sheet1 - 14, Sheet2 - 11 | NOT OK



SHEET 1

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]name1[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]12 - OK[/TD]
[/TR]
[TR]
[TD]name2[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]14 - OK (no color)[/TD]
[/TR]
[TR]
[TD]name3[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]24 - not ok[/TD]
[/TR]
[TR]
[TD]name4[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]21 - ok[/TD]
[/TR]
[TR]
[TD]name5[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]13 - not ok[/TD]
[/TR]
[TR]
[TD]name6[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]12 - ok[/TD]
[/TR]
[TR]
[TD]name7[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]19 - ok[/TD]
[/TR]
[TR]
[TD]name8[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]12 - not ok[/TD]
[/TR]
</tbody>[/TABLE]

SHEET2
[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]name1[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]12 - OK[/TD]
[/TR]
[TR]
[TD]name2[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]12 - OK (no color)[/TD]
[/TR]
[TR]
[TD]name3[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]22 - not ok[/TD]
[/TR]
[TR]
[TD]name4[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]21 - ok[/TD]
[/TR]
[TR]
[TD]name5[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]14 - not ok[/TD]
[/TR]
[TR]
[TD]name6[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]12 - ok[/TD]
[/TR]
[TR]
[TD]name7[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]19 - ok[/TD]
[/TR]
[TR]
[TD]name8[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]x[/TD]
[TD]14 - not ok[/TD]
[/TR]
</tbody>[/TABLE]

 

[StephenCrump]

Here's one way, just tweaking your existing code:

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))
    On Error Resume Next
        .Add Xl.Value & Xl.Offset(, 5).Value, Nothing
        If Xl.Offset(, 5).Value = 14 Then .Add Xl.Value & 12, Nothing   'assumes numeric 14, not string?
    On Error GoTo 0
Next Xl
For Each Xl In Sheets(2).Range("A2", Sheets(2).Range("A" & Rows.Count).End(xlUp))
    ValU = Xl.Value & Xl.Offset(, 16).Value
    If Not .Exists(ValU) Then
        Xl.Offset(, 0).Interior.Color = RGB(157, 157, 157)
        Xl.Offset(, 1).Interior.Color = RGB(230, 130, 130)
    End If
    Next Xl
End With

Excel 2010
	A	F
1
2	Name1	xx
3	Name2	xx
4	Name3	xx
5	Name4	14
6	Name5	xx
7	Name6	xx
8	Name7	12
9	Name8	xx
Sheet1

Excel 2010
	A	B	Q	R
1				Comment
2	Name1		yy	Not found
3	AnotherName		xx	Not found
4	Name2		xx	Found
5	Name4		12	Name4 / 14 found on Sheet1, therefore accept
6	AnotherName		12	Not found
7	Name2		12	Neither Name2 / 12 nor Name2 / 14 exist on Sheet1
8	Name3		xx	Found
9	Name7		12	Found
Sheet2

 

[emukiss10]

Perfect!

Thank You for Your hard work!

 

[StephenCrump]

You're welcome, thanks.