0
votes

Goal:

  1. Search & Compare two Fields Column E (Sheet 2) to Column E (Sheet 1) Return duplicate Values from Sheet 2 to Sheet 3
  2. Show and Highlight Duplicates Highlight Values on Sheet 1 and 2
  3. Copy Duplicate Entries from Sheet 2, then Add to Sheet 3

If Column E(Sheet 2) = Column E(Sheet 1), then copy row(s) from (Sheet 2) and add to Sheet 3

I am trying to compare two excel sheets within a workbook. I want to find duplicate values between sheet 2 and 1 and highlight those values on both sheets. I understand this is a match or vlookup function, but the added layer is I would like to copy those values only from sheet 2 to sheet 3 for visual comparison. I have tried to create a Macro, But this was not helpful and I am in the process of trying to edit this;

Sub rowContent()
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim i As Long, j As Long
    Dim isMatch As Boolean
    Dim newSheetPos As Integer

Set ws1 = ActiveWorkbook.Sheets("Sheet1")
Set ws2 = ActiveWorkbook.Sheets("Sheet2")

'Initial position of first element in sheet2
newSheetPos = ws2.Cells(ws2.Rows.Count, 1).End(xlUp).Row

For i = 1 To ws1.Cells(ws1.Rows.Count, 1).End(xlUp).Row
    isMatch = False
    For j = 1 To ws1.Cells(ws1.Rows.Count, 2).End(xlUp).Row
        If ws1.Cells(i, 1).Value = ws1.Cells(j, 2).Value Then
            ws1.Cells(j, 2).EntireRow.Copy ws2.Cells(newSheetPos, 1)
            isMatch = True
            newSheetPos = newSheetPos + 1
        End If
    Next j
    If isMatch = False Then newSheetPos = newSheetPos + 1
Next i
End Sub

to work for my situation. Any help would be appreciated as I am no Excel Guru.

1
How isn't the code helpful? Does it run, but not work as expected? Does it throw an error (if so, what error/where)? Also, is it a duplicate when E1 on both sheets are the same? Or can a value in Sheet1, Col. E be anywhere in Sheet2 Column E?BruceWayne
sorry, I think is wrote that sentence wrong. There is nothing wrong with the script listed. There was something wrong with the Macro I tried to create. The script listed is what I am currently attempting to re-engineer to fit my specific situation. This script compares two columns on one sheet and extracts data to a second sheet. That is not what I am attempting to do. I am trying to do a VLOOKUP for information from one sheet on another sheet to find duplicate value and then extract that data from the row onto a third sheetNeil

1 Answers

1
votes

You may try something like this...

Sub CopyDuplicates()
Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet
Dim lr1 As Long, lr2 As Long, lc1 As Long, lc2 As Long, r As Long
Dim rng As Range, cell As Range
Application.ScreenUpdating = False

Set ws1 = Sheets("Sheet1")
Set ws2 = Sheets("Sheet2")
Set ws3 = Sheets("Sheet3")

ws3.Cells.Clear
lr2 = ws2.UsedRange.Rows.Count
lc1 = ws1.UsedRange.Columns.Count
lc2 = ws2.UsedRange.Columns.Count

ws1.UsedRange.Interior.ColorIndex = xlNone
ws2.UsedRange.Interior.ColorIndex = xlNone

Set rng = ws2.Range("E1:E" & lr2)
For Each cell In rng
    If Application.CountIf(ws1.Range("E:E"), cell.Value) > 0 Then
        r = Application.Match(cell.Value, ws1.Range("E:E"), 0)
        ws1.Range(ws1.Cells(r, 1), ws1.Cells(r, lc1)).Interior.Color = vbRed
        ws2.Range(ws2.Cells(r, 1), ws2.Cells(r, lc2)).Interior.Color = vbRed
        cell.EntireRow.Copy ws3.Range("A" & Rows.Count).End(3)(2)
    End If
Next cell
ws3.Rows(1).Delete
Application.ScreenUpdating = True
End Sub

The above code assumes that you have three sheets Sheet1, Sheet2 and Sheet3 in the workbook.

The code will remove any existing cell interior color on Sheet1 and Sheet2 before highlighting the rows with duplicates found in red.

If you have applied some color formatting to those sheets, better you use conditional formatting to highlight the rows with duplicates instead of coloring them through the VBA code.