highlight different data between two sheets with another and copy to a new sheet

[KalilMe]

hi
I have two sheets .it should compare with third sheet and should highlight the data are xisted in two sheets(first,second) but they ar not existed in sheet third and copy the highlighted data in a new sheet as fourth sheet

first

PDF2Excel.xls
	A	B	C	D	E
1	CODE	CO	PR	OR	QT
2	AA	km100	MM1	NN1	123
3	BB	km101	MM2	NN2	124
4	CC	km102	MM3	NN3	125
5	DD	km103	MM4	NN4	126
6	EE	km104	MM5	NN5	127
7	FF	km105	MM6	NN6	128
8	GG	km106	MM7	NN7	129
9	HH	km107	MM8	NN8	130
10	JJ	km108	MM9	NN9	131
Main Sheet

second

PDF2Excel.xls
	A	B	C	D	E
1	CODE	CO	PR	OR	Q1
2	AA	km100	MM1	NN1	123
3	BB	km101	MM2	NN2	124
4	CC	km102	MM3	NN3	125
5	DD	km103	MM4	NN4	126
6	EE	km104	MM5	NN5	127
7	FF	km105	MM6	NN6	128
8	GG	km106	MM7	NN7	129
9	NN	km107	MM8	NN8	130
10	KK	km108	MM9	NN9	131
Page-1

third

PDF2Excel.xls
	A	B	C	D	E	F
1	CODE	CO	PR	OR	QT	Q1
2	AA	km100	MM1	NN1	123	123
3	BB	km101	MM2	NN2	124	124
4	CC	km102	MM3	NN3	125	125
5	DD	km103	MM4	NN4	126	126
6	EE	km104	MM5	NN5	127	127
7	FF	km105	MM6	NN6	128	128
8	GG	km106	MM7	NN7	129	129
Page-2

fourth

PDF2Excel.xls
	A	B	C	D	E	F
1	CODE	CO	PR	OR	QT	Q1
2	HH	km107	MM8	NN8	130	-
3	JJ	km108	MM9	NN9	131	-
4	NN	km107	MM8	NN8	-	130
5	KK	km108	MM9	NN9	-	131
RE

thanks

 

[DanteAmor]

Try this:

Sub highlight_different_data()
  Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet, sh4 As Worksheet
  Dim dic As Object
  Dim i As Long, lr As Long
  
  Application.ScreenUpdating = False
  Set sh1 = Sheets("Main sheet")  'first
  Set sh2 = Sheets("Page-1")      'second
  Set sh3 = Sheets("Page-2")      'third
  Set sh4 = Sheets("RE")          'fourth
  Set dic = CreateObject("Scripting.Dictionary")
  sh4.Rows("2:" & Rows.Count).ClearContents
  
  For i = 2 To sh3.Range("A" & Rows.Count).End(3).Row
    dic(sh3.Range("A" & i).Value) = Empty
  Next
  
  For i = 2 To sh1.Range("A" & Rows.Count).End(3).Row
    If Not dic.exists(sh1.Range("A" & i).Value) Then
      With sh1.Range("A" & i).Resize(1, 5)
        .Interior.Color = vbRed
        lr = sh4.Range("A" & Rows.Count).End(3)(2).Row
        sh4.Range("A" & lr).Resize(1, 5).Value = .Value
        sh4.Range("F" & lr).Value = "-"
      End With
    End If
  Next
  For i = 2 To sh2.Range("A" & Rows.Count).End(3).Row
    If Not dic.exists(sh2.Range("A" & i).Value) Then
      With sh2.Range("A" & i).Resize(1, 5)
        .Interior.Color = vbRed
        lr = sh4.Range("A" & Rows.Count).End(3)(2).Row
        sh4.Range("A" & lr).Resize(1, 5).Value = .Value
        sh4.Range("E" & lr).Value = "-"
        sh4.Range("F" & lr).Value = sh2.Range("E" & i).Value
      End With
    End If
  Next
End Sub

 

[KalilMe]

perfect ! but I have last thing when change the data in sheet Page-2 and become matched with the two sheets . it supposes delete the back color for data were not matched in two sheets in previous time. may . you fix it please?

 

[DanteAmor]

Try this:

Sub highlight_different_data()
  Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet, sh4 As Worksheet
  Dim dic As Object
  Dim i As Long, lr As Long
  
  Application.ScreenUpdating = False
  Set sh1 = Sheets("Main sheet")  'first
  Set sh2 = Sheets("Page-1")      'second
  Set sh3 = Sheets("Page-2")      'third
  Set sh4 = Sheets("RE")          'fourth
  Set dic = CreateObject("Scripting.Dictionary")
  dic.comparemode = vbTextCompare
  
  sh1.Rows("2:" & Rows.Count).Interior.Color = xlNone
  sh2.Rows("2:" & Rows.Count).Interior.Color = xlNone
  sh4.Rows("2:" & Rows.Count).ClearContents
  
  For i = 2 To sh3.Range("A" & Rows.Count).End(3).Row
    dic(sh3.Range("A" & i).Value) = Empty
  Next
  
  For i = 2 To sh1.Range("A" & Rows.Count).End(3).Row
    If Not dic.exists(sh1.Range("A" & i).Value) Then
      With sh1.Range("A" & i).Resize(1, 5)
        .Interior.Color = vbRed
        lr = sh4.Range("A" & Rows.Count).End(3)(2).Row
        sh4.Range("A" & lr).Resize(1, 5).Value = .Value
        sh4.Range("F" & lr).Value = "-"
      End With
    End If
  Next
  For i = 2 To sh2.Range("A" & Rows.Count).End(3).Row
    If Not dic.exists(sh2.Range("A" & i).Value) Then
      With sh2.Range("A" & i).Resize(1, 5)
        .Interior.Color = vbRed
        lr = sh4.Range("A" & Rows.Count).End(3)(2).Row
        sh4.Range("A" & lr).Resize(1, 5).Value = .Value
        sh4.Range("E" & lr).Value = "-"
        sh4.Range("F" & lr).Value = sh2.Range("E" & i).Value
      End With
    End If
  Next
End Sub

 

[KalilMe]

that's very excellent ! I would ask from you about your code to understand if you don't mind . based on your code you match the data based on column A right or wrong? if it 's right if I would match based on column B,C,D together how can I mod . if you see it's simple just tell me if you see that create new code . forget it . just curoisity !

 

[DanteAmor]

based on your code you match the data based on column A right or wrong?

Right

if it 's right if I would match based on column B,C,D together how can I mod .

Then the data from columns B, C and D must be added to the index.
The same in validation. I show you the changes in blue:

Sub highlight_different_data_2()
  Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet, sh4 As Worksheet
  Dim dic As Object, ky As Variant
  Dim i As Long, lr As Long
  
  Application.ScreenUpdating = False
  Set sh1 = Sheets("Main sheet")  'first
  Set sh2 = Sheets("Page-1")      'second
  Set sh3 = Sheets("Page-2")      'third
  Set sh4 = Sheets("RE")          'fourth
  Set dic = CreateObject("Scripting.Dictionary")
  dic.comparemode = vbTextCompare
  
  sh1.Rows("2:" & Rows.Count).Interior.Color = xlNone
  sh2.Rows("2:" & Rows.Count).Interior.Color = xlNone
  sh4.Rows("2:" & Rows.Count).ClearContents
  
  For i = 2 To sh3.Range("A" & Rows.Count).End(3).Row
    ky = sh3.Range("B" & i).Value & "|" & sh3.Range("C" & i).Value & "|" & sh3.Range("D" & i).Value
    dic(ky) = Empty
  Next
  
  For i = 2 To sh1.Range("A" & Rows.Count).End(3).Row
    ky = sh1.Range("B" & i).Value & "|" & sh1.Range("C" & i).Value & "|" & sh1.Range("D" & i).Value
    If Not dic.exists(ky) Then
      With sh1.Range("A" & i).Resize(1, 5)
        .Interior.Color = vbRed
        lr = sh4.Range("A" & Rows.Count).End(3)(2).Row
        sh4.Range("A" & lr).Resize(1, 5).Value = .Value
        sh4.Range("F" & lr).Value = "-"
      End With
    End If
  Next
  For i = 2 To sh2.Range("A" & Rows.Count).End(3).Row
    ky = sh2.Range("B" & i).Value & "|" & sh2.Range("C" & i).Value & "|" & sh2.Range("D" & i).Value
    If Not dic.exists(ky) Then
      With sh2.Range("A" & i).Resize(1, 5)
        .Interior.Color = vbRed
        lr = sh4.Range("A" & Rows.Count).End(3)(2).Row
        sh4.Range("A" & lr).Resize(1, 5).Value = .Value
        sh4.Range("E" & lr).Value = "-"
        sh4.Range("F" & lr).Value = sh2.Range("E" & i).Value
      End With
    End If
  Next
End Sub

 

[KalilMe]

magnificent ! you're super great !
many thanks for your great solution

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.