Comparing Two Excel Sheets and copying like data to third

Closed
tyhipo
Posts
2
Registration date
Friday June 23, 2017
Status
Member
Last seen
July 11, 2017
- Updated on Jun 24, 2017 at 08:52 AM
vcoolio
Posts
1356
Registration date
Thursday July 24, 2014
Status
Moderator
Last seen
August 11, 2022
- Jul 13, 2017 at 06:29 AM
Hello,
I used the below answer and it works but i actually need to tweak it to copy from the second sheet.
So I have sheet 1 has full data and column A matchtes column E in sheet two with a different set of date that i don't need. So I want to copy each row from sheet 1 where column A sheet one matches column E sheet two.

The issue that I'm having is that its comparing column A sheet one to Column E sheet two and copying Column A sheet one. BUT column A sheet one has duplicates where as column E sheet two has unique values.
I've been playing around with the code provided in the original answer to this question and I've had no luck!

3 replies

vcoolio
Posts
1356
Registration date
Thursday July 24, 2014
Status
Moderator
Last seen
August 11, 2022
250
Jun 24, 2017 at 08:50 AM
Hello Tyhipo,

Which code did you try? Could you please post it for us to examine.

Thank you.
vcoolio.
0
tyhipo
Posts
2
Registration date
Friday June 23, 2017
Status
Member
Last seen
July 11, 2017

Jul 11, 2017 at 02:40 PM
Hi Vcoolio! Sorry it took me so long but here is what I used from the other answer solution.

Sub RunMe()
Dim lRow, x As Long

Sheets("Sheet1").Select
lRow = Range("C1").End(xlDown).Row

For Each cell In Range("C2:C" & lRow)
x = 2
Do
If cell.Value = Sheets("Sheet2").Cells(x, "E").Value Then
cell.EntireRow.Copy Sheets("Sheet3").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
End If
x = x + 1
Loop Until IsEmpty(Sheets("Sheet2").Cells(x, "E"))
Next

End Sub
0
vcoolio
Posts
1356
Registration date
Thursday July 24, 2014
Status
Moderator
Last seen
August 11, 2022
250
Jul 13, 2017 at 06:29 AM
Hello Tyhipo,

If you only want to copy rows with unique values in Column E (Sheet2), then try the following code:-

Sub TryAgain()

    Dim lr As Long
    Dim fValue As Range

lr = Range("A" & Rows.Count).End(xlUp).Row

For Each cell In Sheet2.Range("E2:E" & lr)
    Set fValue = Sheet1.Columns("A:A").Find(cell.Value)
    If fValue Is Nothing Then GoTo NextCell
    If cell.Value = fValue.Value Then
    cell.EntireRow.Copy Sheet3.Range("A" & Rows.Count).End(3)(2)
    End If
NextCell:
Next cell

Sheet3.Select

End Sub


Run the code from Sheet2.

I hope that this helps.

Cheerio,
vcoolio.
0