+ Reply to Thread
Results 1 to 8 of 8

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

  1. #1
    kilo1990
    Guest

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

    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...


  2. #2
    Dave Peterson
    Guest

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

    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



    kilo1990 wrote:
    >
    > 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...


    --

    Dave Peterson

  3. #3
    kilo1990
    Guest

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

    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?


  4. #4
    Dave Peterson
    Guest

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

    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????

    kilo1990 wrote:
    >
    > 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?


    --

    Dave Peterson

  5. #5
    kilo1990
    Guest

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

    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....


  6. #6
    Dave Peterson
    Guest

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

    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.



    kilo1990 wrote:
    >
    > 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....


    --

    Dave Peterson

  7. #7
    kilo1990
    Guest

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

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


  8. #8
    Dave Peterson
    Guest

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

    Sorry, it took so long to get it straight.

    But glad it worked out.

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


    --

    Dave Peterson

+ Reply to Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1