Match and Copy to Next Sheet

[K]

Hi all, I have two Sheets. One Sheet is call "Data" and other call
"Report". I have data in Sheets("Data") (see below)

A B C D E ------columns
REF AC CC FO DK -------headings
356GFFFR 356 GFF FR 12
563XTRZS 563 XTR ZS 13
563XTRZS 563 XTR ZS 14
455TRERE 455 TRE RE 18
455TRERE 455 TRE RE 18
899VREXX 899 VRE XX 15
899VREXX 899 VRE XX 16
788SEPRE 788 SEP RE 20

I want macro which should check column A cells values and then column
E cells values and if any value in column A match eachother but value
in same row of column E is different then macro should copy that row
from column B to E into Sheets("Report") and paste in row 2 to down as
row 1 have headings. I hope i was able to explain my question.
Please can any friend help?

Macro should produce result something like this (see below) in Sheets
("Report")

A B C D ----- columns
AC CC FO DK------headings
563 XTR ZS 13
563 XTR ZS 14
899 VRE XX 15
899 VRE XX 16

 

[Joel]

Because you may have multiple (more than 2) items with the same REF I think
it is better to remove the matching items rather than copying the
non-matching. so I copied everything and then deleted what you didn't want.

Sub getduplicates()

'clear Report Sheet
Sheets("Report").Cells.ClearContents
'copy Data sheet to reports
Sheets("Data").Cells.Copy _
Destination:=Sheets("Report").Cells

With Sheets("Report")
'Sort Data sheet
LastRow = .Range("A" & Rows.Count).Row
.Rows("1:" & LastRow).Sort _
key1:=.Range("A1"), _
order1:=xlAscending, _
header:=xlYes

'Delete rows that are the same
RowCount = 2
Do While .Range("A" & (RowCount + 1)) <> ""
If .Range("A" & RowCount) = .Range("A" & (RowCount + 1)) And _
.Range("E" & RowCount) = .Range("E" & (RowCount + 1)) Then

.Rows(RowCount + 1).Delete
Else
RowCount = RowCount + 1
End If
Loop

'Remove single entries
RowCount = 2
Do While .Range("A" & RowCount) <> ""
Ref = .Range("A" & RowCount)
Num = WorksheetFunction.CountIf(.Columns("A"), Ref)
If Num = 1 Then
.Rows(RowCount).Delete
Else
RowCount = RowCount + 1
End If
Loop
End With
End Sub

 

[K]

Because you may have multiple (more than 2) items with the same REF I think
it is better to remove the matching items rather than copying the
non-matching.  so I copied everything and then deleted what you didn't want.

Sub getduplicates()

'clear Report Sheet
Sheets("Report").Cells.ClearContents
'copy Data sheet to reports
Sheets("Data").Cells.Copy _
   Destination:=Sheets("Report").Cells

With Sheets("Report")
   'Sort Data sheet
   LastRow = .Range("A" & Rows.Count).Row
   .Rows("1:" & LastRow).Sort _
      key1:=.Range("A1"), _
      order1:=xlAscending, _
      header:=xlYes

   'Delete rows that are the same
   RowCount = 2
   Do While .Range("A" & (RowCount + 1)) <> ""
      If .Range("A" & RowCount) = .Range("A" & (RowCount + 1)) And _
         .Range("E" & RowCount) = .Range("E" & (RowCount + 1)) Then

         .Rows(RowCount + 1).Delete
      Else
         RowCount = RowCount + 1
      End If
   Loop

   'Remove single entries
   RowCount = 2
   Do While .Range("A" & RowCount) <> ""
      Ref = .Range("A" & RowCount)
      Num = WorksheetFunction.CountIf(.Columns("A"), Ref)
      If Num = 1 Then
         .Rows(RowCount).Delete
      Else
         RowCount = RowCount + 1
      End If
   Loop
End With
End Sub









- Show quoted text -

Thanks joel