Compare 2 Sheets and Extract Unique Info to a 3rd Sheet

K

kilo1990

I have two sheets of stock data from a stock screener, both same
parameters, just different time frames (i.e., one sheet is newer
whenever I import new a new screen from the Internet), which will pull
different stocks as time passes. I'm trying to compare the two sheets
and extract the stock data (a whole row's worth of data, not just a
cell) that is unique to the "Last Import" sheet. This would allow any
new stocks identified on the screener to be transferred to a new sheet
(called "Filtered List"). That way I don't have to research the same
stocks over and over, only the new ones that show up with each import.
I did some searching on the Internet and found the following code,
which I modified to include the sheet names:

Sub CompareMove()
'
Dim lastrowsh1 As Long, lastrowsh2 As Long, lastrowsh3 As Long
Dim searchRng As Range, foundRng As Range
Dim Ws1 As Worksheet, Ws2 As Worksheet, Ws3 As Worksheet
lastrowsh1 = Worksheets("Previous
Import").Range("a65536").End(xlUp).Row
lastrowsh2 = Worksheets("Last
Import").Range("a65536").End(xlUp).Row
lastrowsh3 = Worksheets("Filtered
List").Range("a65536").End(xlUp).Row
Set Ws1 = Worksheets("Previous Import")
Set Ws2 = Worksheets("Last Import")
Set Ws3 = Worksheets("Filtered List")

Set searchRng = Ws2.Columns(1) 'sets column a on Previous Import

With Ws2
For x = 5 To lastrowsh2
Set foundRng = searchRng.Find(Ws1.Cells(x, 1)) 'loop through the
previous import
If Not foundRng Is Nothing Then
foundRng.EntireRow.Copy 'on a match copy row
Ws3.Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial
End If
Next x
End With
End Sub

This is almost what I'm looking for, right now when it runs it extracts
the data COMMON to both sheets, rather than what is UNIQUE which is
what I need it to do. It looks like I'm sooooo close...can someone
tell me what code I need to modify to make it do this? I don't have
too much knowledge outside of basic macro building, and I would be very
grateful for ANY assistance y'all could provide.

Thanks in advance...
 
D

Dave Peterson

This line:

If Not foundRng Is Nothing Then

Essentially says "If foundrng is something"--that the previous find was
successful, then do the work.

Since you want to do the work if it wasn't found, try removing "not" from that
line:

If foundRng Is Nothing Then
 
K

kilo1990

I took out the "not" per your suggestion and now the following error
comes up:

Runtime error '91': Object Variable or With Block variable not set

Then the following line is highlighted:
foundRng.EntireRow.Copy 'on a match copy row

What's next?
 
D

Dave Peterson

Yep. My mistake.

What do you want to copy? The cell with the value that you're searching for?



With Ws2
For x = 5 To lastrowsh2
Set foundRng = searchRng.Find(Ws1.Cells(x, 1))
If Not foundRng Is Nothing Then
ws1.rows(x).Copy
Ws3.Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial
End If
Next x
End With

You may have to change your ranges around to loop through the cells on ws1 and
compare then with searchrng????
 
K

kilo1990

I'm wanting to copy the rows that are unique to the "Last Import" sheet
beginning at A6. The "Previous Import" sheet will be yesterday's data.
The "Last Import" tab will have some stocks from the previous day's
trading, but I'm only interested in the new stocks that hit today
(hence the "Filtered List" sheet). I'm not sure what todo, I pasted
your last code in there and it still transferring the data common to
both sheets, as opposed to what is unique in the "Last Import" tab.
HELP....
 
D

Dave Peterson

Doh.

I changed the code, but I forgot to remove the "NOT" from that check:

With Ws2
For x = 5 To lastrowsh2
Set foundRng = searchRng.Find(Ws1.Cells(x, 1))
If foundRng Is Nothing Then
ws1.rows(x).Copy
Ws3.Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial
End If
Next x
End With

=======
Here's one that looks at differences between either list:

Option Explicit

Sub CompareMove()

Dim lastrowSh1 As Long
Dim lastrowSh2 As Long
Dim lastrowSh3 As Long

Dim X As Long

Dim foundRng As Range

Dim Ws1 As Worksheet
Dim Ws2 As Worksheet
Dim Ws3 As Worksheet

Set Ws1 = Worksheets("Previous Import")
Set Ws2 = Worksheets("Last Import")
Set Ws3 = Worksheets("Filtered List")

lastrowSh1 = Ws1.Range("a65536").End(xlUp).Row
lastrowSh2 = Ws2.Range("a65536").End(xlUp).Row
lastrowSh3 = Ws3.Range("a65536").End(xlUp).Row

With Ws2
For X = 5 To lastrowSh1
With .Columns(1)
Set foundRng = .Find(what:=Ws1.Cells(X, 1), _
after:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
lookat:=xlWhole, _
searchorder:=xlByRows, _
searchdirection:=xlNext, _
MatchCase:=False)
End With

If foundRng Is Nothing Then
Ws1.Rows(X).Copy 'on a match copy row
Ws3.Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial
End If
Next X
End With

With Ws1
For X = 5 To lastrowSh2
With .Columns(1)
Set foundRng = .Find(what:=Ws2.Cells(X, 1), _
after:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
lookat:=xlWhole, _
searchorder:=xlByRows, _
searchdirection:=xlNext, _
MatchCase:=False)
End With

If foundRng Is Nothing Then
Ws2.Rows(X).Copy 'on a match copy row
Ws3.Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial
End If
Next X
End With

End Sub


If you don't want both sets of differences, then delete one of them.

ps. When you're doing .find's in code, it's better to specify exactly what you
want. Excel & VBA remembers the last thing that was used--either by the user or
by code.
 
K

kilo1990

WOW, DAVE, THEY BOTH WORK. Both the original code AND the one you
suggested...this is GREAT. Thanks so much for taking the time!
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top