Challenging Excel Issue Re: Comparing 2 Spreadsheets

Jeff,

Welcome to the forum.

Yes, you explained it very well. I'll start working on this as soon as I can.

Something like this?
See attached

Ah, Jolivanes...

Please note that in addition to looking for new titles, when a matching ID has been found, he's looking to see if cost or quantity has been changed from Sheet 1 and Sheet 2. If so, he wishes to have those records listed too.

(I was wondering why your code was SO much shorter than mine. But I can see that even when you fix this, it will still be shorter. Good work.)

@ Ed_Collins
I cheated. I use this code a lot for comparing. Someone else (don't know who anymore) wrote it and I was still working on the other requirements. To no avail so far I might say.

Thanks to both of you. The two sets of code look like they're written in 2 different programming languages. Yes?

@Ed_Collins
I really liked the way you did that. It takes FOREVER...but not as long as doing it by hand

@jolivanes
If you happen to come up with something, I'd love to see it as well.

Here's a new one -- Is there any way to make it make some sort of noise when it's finished working?

Thanks again guys!
Jeff

Right now I have between 8 and 10 thousand rows per worksheet. I will be increasing that amount soon though to over 100 thousand.

I'll try out the new code and let you know how it goes.

Thanks for the help.
Jeff

Jeff,

How many rows of data do you have?

If it takes "forever" then it sounds like you have a lot. If speed is important, I think I can speed it up a bit.

And yes, that's not something I often do, but I should be able to send an audio signal of some kind, when it's done.

Version 2 coming up...

With that many records, I should probably add a status bar message, indicating the percentage done.

The nice thing about a status indicator is you know about how long the program will take and can see that it's working.

The BAD thing about a status bar message is that the program would take even longer to run. (More code... it would have to continuously check the progress and display it for the user.)

The main reason it takes so long with your actual data is because the IDs aren't sorted. Currently, with the code written, when an ID is "selected" on Sheet 1, it is then looked for, sequentially, on Sheet 2. It has to be looked for sequentially because the list is in no order.

However, if the entire tables were sorted by ID, the speedup would be tremendous.

1) I could still search sequentially, but as soon as an ID on Sheet 2 was greater than that of the ID on Sheet 1, the loop could terminate early. In that case it can't possibly exist further down. That alone would speed things up. However...

2) ...Better yet, I could write a binary search routine, which would be faster yet. And with 100,000 records, a binary search is really the only way to go. With 100,000 records, you can pinpoint any record in only about 17 searches... because you're dividing the list in half each time.

If you want the list returned to its original state after I sort it, I can do that too.

But when you say it takes "forever" what are we talking about here? How many minutes now? And how often do you run this? For example, if it just takes a few minutes to run, and if you only run it once a week or even once a day, you can get a drink from the water cooler, or use the bathroom or something, while it's running.

But if you run it several times a day, or if it takes 30+ minutes to run, that's worth taking the time to re write it.

See if this works and how long it'll take on your workbook.
Maybe save a copy of your workbook and cut the records to 5,000. If that is very slow just forget about this code.
Put the code in a regular module and run it from sheet "Movies-New-allReport"

Sub Compare_Cols()
    Dim x As Long, lr As Long, i As Long, nr As String
    Dim t
    t = Timer
    Application.ScreenUpdating = False
    lr = Cells(Rows.Count, 1).End(xlUp).Row
    For i = 1 To lr
        If Application.WorksheetFunction.CountIf(Sheets("Sheet1").Range("A:A"), Sheets("Movies-New-allReport").Range("A" & i)) = 0 Then _
           Rows(i).EntireRow.Copy Sheets("Sheet3").Range("A" & Rows.Count).End(xlUp)(2)
    Next i
    Sheets("Sheet3").Range("A2:A" & Sheets("Sheet3").Cells(Rows.Count, 1).End(xlUp).Row).Interior.Color = vbRed
    nr = Sheets("Sheet3").Cells(Rows.Count, 1).End(xlUp).Row + 1
    lr = Cells(Rows.Count, 1).End(xlUp).Row
    For i = 1 To lr
        If Application.WorksheetFunction.CountIf(Sheets("Sheet1").Range("F:F"), Sheets("Movies-New-allReport").Range("F" & i)) = 0 Then _
           Rows(i).EntireRow.Copy Sheets("Sheet3").Range("A" & Rows.Count).End(xlUp)(2)
    Next i
    Sheets("Sheet3").Range("A" & nr & ":A" & Sheets("Sheet3").Cells(Rows.Count, 1).End(xlUp).Row).Offset(, 5).Interior.Color = vbGreen
    nr = Sheets("Sheet3").Cells(Rows.Count, 1).End(xlUp).Row + 1
    lr = Cells(Rows.Count, 1).End(xlUp).Row
    For i = 1 To lr
        If Application.WorksheetFunction.CountIf(Sheets("Sheet1").Range("G:G"), Sheets("Movies-New-allReport").Range("G" & i)) = 0 Then _
           Rows(i).EntireRow.Copy Sheets("Sheet3").Range("A" & Rows.Count).End(xlUp)(2)
    Next i
    Sheets("Sheet3").Range("A" & nr & ":A" & Sheets("Sheet3").Cells(Rows.Count, 1).End(xlUp).Row).Offset(, 6).Interior.Color = vbYellow
    Application.ScreenUpdating = True
    MsgBox "This macro took " & Format(Round(Timer - t, 2), "00:00:00.00") & " seconds to run."
End Sub

Jeff
This uses native formulae which is faster.
It does assume that Column M is empty (free to use for the formulae).
Let us know if there is any time gain or loss.

Sub Sel_Rng_B()
    Dim myrange1 As Range, myrange2 As Range
    Dim nr As String
    Dim t
    t = Timer
    Application.ScreenUpdating = False

    Set myrange1 = Sheets("Movies-New-allReport").Range("A2:A" & Sheets("Movies-New-allReport").Cells(Rows.Count, 1).End(xlUp).Row)
    Set myrange2 = Sheets("Sheet1").Range("A2:A" & Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row)
    myrange1.Offset(, 12).Formula = "=VLOOKUP(RC[-12]," & myrange2.Address(True, True, xlR1C1, True) & ",1,FALSE)"
    With ActiveSheet.Range("M1:M" & Cells(Rows.Count, 13).End(xlUp).Row)
        .AutoFilter Field:=1, Criteria1:="#N/A"
    End With
    Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row).Resize(, 11).SpecialCells(12).Copy Sheets("Sheet3").Range("A" & Rows.Count).End(xlUp)(2)
    ActiveSheet.AutoFilterMode = False: Range("M:M").ClearContents
    Sheets("Sheet3").Range("A2:A" & Sheets("Sheet3").Cells(Rows.Count, 1).End(xlUp).Row).Interior.Color = vbRed
    nr = Sheets("Sheet3").Cells(Rows.Count, 1).End(xlUp).Row + 1

    myrange1.Offset(, 12).Formula = "=VLOOKUP(RC[-7]," & myrange2.Offset(, 5).Address(True, True, xlR1C1, True) & ",1,FALSE)"
    With ActiveSheet.Range("M1:M" & Cells(Rows.Count, 13).End(xlUp).Row)
        .AutoFilter Field:=1, Criteria1:="#N/A"
    End With
    Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row).Resize(, 11).SpecialCells(12).Copy Sheets("Sheet3").Range("A" & Rows.Count).End(xlUp)(2)
    ActiveSheet.AutoFilterMode = False: Range("M:M").ClearContents
    Sheets("Sheet3").Range("A" & nr & ":A" & Sheets("Sheet3").Cells(Rows.Count, 1).End(xlUp).Row).Offset(, 5).Interior.Color = vbGreen
    nr = Sheets("Sheet3").Cells(Rows.Count, 1).End(xlUp).Row + 1

    myrange1.Offset(, 12).Formula = "=VLOOKUP(RC[-6]," & myrange2.Offset(, 6).Address(True, True, xlR1C1, True) & ",1,FALSE)"
    With ActiveSheet.Range("M1:M" & Cells(Rows.Count, 13).End(xlUp).Row)
        .AutoFilter Field:=1, Criteria1:="#N/A"
    End With
    Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row).Resize(, 11).SpecialCells(12).Copy Sheets("Sheet3").Range("A" & Rows.Count).End(xlUp)(2)
    ActiveSheet.AutoFilterMode = False: Range("M:M").ClearContents
    Sheets("Sheet3").Range("A" & nr & ":A" & Sheets("Sheet3").Cells(Rows.Count, 1).End(xlUp).Row).Offset(, 6).Interior.Color = vbYellow

    Application.ScreenUpdating = True
    MsgBox "This macro took " & Format(Round(Timer - t, 2), "00:00:00.00") & " seconds to run."
End Sub

Jeff, are you still interested?

Just for fun, I put together a binary search routine, as I mentioned earlier. I still have some cleaning up to do, but preliminary tests indicate it can search through and print the differences for 100,000 of your records in less than two seconds.

I do have a couple of questions for you though.

Ed

@Ed_Collins
That's a heck of a lot faster then the code in post #14 (34 seconds for 25,000 records on my machine)

Is it? I'm so sorry, but I haven't had a chance to even check out or look at your code yet. (Actually, I glanced at it, and much of it I didn't understand.)

Wow, 34 seconds for 25,000 records. Actually, that's probably not bad, since my initial code was probably a lot, lot slower than that.

I'm still learning the syntax and how to code in VBA. Oh, I know how to write programs... I've been programming for over 24 years. (COBOL on a mainframe, back in the early80s.) But a LOT of VBA and what you can do with some of the statements and applications and functions, is still new to me. That's why I'm here... to learn.

I'm still not even convinced my little binary search routine is ideal. There's probably some Excel vba tricks that will do it even faster. But to an old fogey like me, I have to rely on the basics... and what I do know. And a binary search is probably taught in Programming 101.

hey,

i don't really want to intrude here since you guys are doing fine, but since Ed has 25,000 records to test, I'm just curious to see how long the following code takes. if indeed it works.

the code follows the data setup in Sample Video Sheet - modified 02.
It's supposed to just copy the changed rows, but not to highlight where the specific changes occur.

Sub changes()
Dim d As Object, s As String, a, i As Long, q()

Set d = CreateObject("scripting.dictionary")
s = Chr(30)
a = Sheets("Sheet2").Cells(1).CurrentRegion
For i = 1 To UBound(a, 1)
    d(a(i, 4) & s & a(i, 6) & a(i, 7)) = True
Next i

With Sheets("Movies-New-allReport").Cells(1).CurrentRegion
a = .Value
ReDim q(1 To UBound(a, 1), 1 To 1)
    For i = 1 To UBound(a, 1)
        If Not d(a(i, 4) & s & a(i, 6) & a(i, 7)) Then q(i, 1) = 1
    Next i
    With .Cells(1, "m").Resize(UBound(a, 1))
        .Value = q
        .SpecialCells(xlConstants).EntireRow.Copy _
            Sheets("Differences Between Sheets").Cells(5, 1)
        .ClearContents
    End With
End With

End Sub

I ran it on a test data set I have, that has 200,000 records. It ran, and seemed to correctly point out the differences, in under 3 seconds!

This is less than half the time my latest code runs. With the same 200,000 record dataset, my code runs in 7 seconds... and I thought that was pretty good.

Very nice work. Now I'm not even in a hurry to post my code.

@Ed,

Thanks for your trouble and for your comments. I was just curious. Mainly to see how the SpecialCells bit worked. I expected it to be slower then that, but I think there's a faster/better approach anyway.

You're doing great, and I won't intrude any further on the thread.

Jeff, here's my workbook.

(This file has just 500 test records. Size limitations prevent me from uploading my 200,000 test workbook, and there would be no reason to do that anyhow.)

Sample Video Sheet - modified with new binary search.xlsm

Holy crap! It took less than a second to run this on my laptop! That is excellent! Thank you soooooo much! I am so impressed and jealous. I wish I had the knowledge to do this kind of stuff.

I am so grateful and appreciative.

Thank you.
Jeff