VBA code optimization

[Lorlai]

I am comparing two sheets, trying to find changes. These sheets contain large amounts of data (From Columns A:DA, and over 9,000 rows). Because of this, my code is incredibly slow, taking up to 30 min to run. Is there a way to optimize my code? I have already turned off automatic calculations and the screen update. Any help with this would be appreciated!!

Sub Test()
Application.ScreenUpdating = False
'Getting Ready to Name the final sheet
Dim TodayDate As String
TodayDate = Format(Date, "mmm-dd-yyyy")

'Choosing a previous file
MsgBox "Please choose a previous File"
PreviousWorkbook = Application.GetOpenFilename _
(Title:="Please choose a previous file", _
FileFilter:="Excel Files *.xls* (*.xls*),")
''
If PreviousWorkbook = False Then
MsgBox "No file specified.", vbExclamation, "Error"
Exit Sub
Else
Workbooks.Open Filename:=PreviousWorkbook
End If

'Copying the Source data from the Previous File to the Changes Workbook
Sheets("RM Data List").Select
ActiveSheet.Copy After:=Workbooks("Changes.xlsm").Sheets(1)
ActiveSheet.Name = "Previous"

'Choosing a current file
MsgBox "Please choose the Current File"
CurrentWorkbook = Application.GetOpenFilename _
(Title:="Please choose the current file", _
FileFilter:="Excel Files *.xls* (*.xls*),")
''
If CurrentWorkbook = False Then
MsgBox "No file specified.", vbExclamation, "Error"
Exit Sub
Else
Workbooks.Open Filename:=CurrentWorkbook
End If

'Copying the Source Data from the Current file to the Changes Workbook
Sheets("Source Data").Select
ActiveSheet.Copy After:=Workbooks("Changes.xlsm").Sheets(1)
ActiveSheet.Name = "Current"


Application.Calculation = xlCalculationManual

Sheets("Previous").Select
Columns("A:DZ").Select
    Selection.NumberFormat = "General"
    Selection.Replace What:="", Replacement:="BLANK", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
Range("A1").Select

Sheets("Current").Select
Columns("A:DZ").Select
    Selection.NumberFormat = "General"
    Selection.Replace What:="", Replacement:="BLANK", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
Range("A1").Select

Do
Sheets("Previous").Select
CellValue = ActiveCell.Value

Sheets("Current").Select
    If ActiveCell.Value <> CellValue Then
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent5
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    End If
ActiveCell.Offset(0, 1).Select

Sheets("Previous").Select
ActiveCell.Offset(0, 1).Select

If IsEmpty(ActiveCell) Then
    Sheets("Previous").Select
    ActiveCell.Offset(1, 0).Select
    ActiveSheet.Cells(ActiveCell.Row, 1).Select
    Sheets("Current").Select
    ActiveCell.Offset(1, 0).Select
    ActiveSheet.Cells(ActiveCell.Row, 1).Select
End If

Loop Until IsEmpty(ActiveCell)

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

 

[Lorlai]

What type of simple formulas would be used in between these massive amounts of data? So I would need to copy the current data sheet right next to the previous data, with only a column in between? This sounds super easy, but I am not certain at all where to start with this...

 

[Norie]

The formula is just something like this copied across and down.

=A2=BU2

Where one set of data starts in A2 and the other BU2.

That will return TRUE if there's a match and FALSE if there isn't.

It's a very crude method of doing something like this, but it does work and I've used it in the past on large amounts of data.

That was mainly for presentation though and the formula was used to highlight differences using conditional formatting.

Oh, and it does take a moment or two to calculate.

By the way, how big are the files you are dealing with?

 

[Lorlai]

Wow, that is a great solution! I can make this work.

Just wondering, is there way to make this work by having the formula on a sheet already? Like opening the master workbook, and having sheet one containing the formula already, then bringing in the two sheets to compare and have the formula auto calculate?

I tried writing this out, but can't get it to work:

='P'!A2 = 'C'!A2

This formula returns a false, even if the data matches. Similarly:

=P!A2 = 'C'!A2

Returns True even if the data is different. If I go through and manually delete the quotes around the C, then I am able to get the correct Boolean. Do you know of a way to get around this?

 

[Norie]

Are you copying the data to one worksheet?

That might not seem the best idea but it actually is, I think anyway.

One definite advantage is you wouldn't need worksheet references in the formula.

As for existng formulas, I don't know if that would work - I've never tried it.

Why do you want to try that anyway?

Is it because of the no of formulas you need to enter?

 

[Lorlai]

The ultimate goal of this is to make the amount of user interaction as minimal as possible. Ideally, all the user should have to do is click to start a macro, and then select which two workbooks he wants to compare.

In my mind, that would mean the easiest way to do this would be to have the worksheets I need to copy from the two workbooks pulled into my master workbook, then already have the formulas on a single worksheet. Then when the two worksheets are copied over, in theory, the formula worksheet will automatically be filled in and I can perform further work from there.

Is there a better way to do this?

P.S. Norie, you are my angel! Thank you so much for all of your help with this so far, I appreciate it more than you know!

 

[Norie]

It can all be done in code.

Let's say the data for each worksheet is in A1:BC200.

This code will copy the data and insert the formulas on a new worksheet.

Sub test()
Dim wsnew As Worksheet
    Set wsnew = Worksheets.Add
 
    ' copy current data onto new worksheet
    Worksheets("Current").Range("A1:BC200").Copy wsnew.Range("A1")
 
    ' copy previous data onto new worksheet, below the current data with 2 rows inbetween
 
    Worksheets("Previous").Range("A1:BC200").Copy wsnew.Range("A" & Rows.Count).End(xlUp).Offset(3)
 
    ' enter formula's to the right of current data, with 2 columns inbetween
 
    wsnew.Range("A1:BC200").Offset(, wsnew.Cells(1, Columns.Count).End(xlToLeft).Column + 2).Formula = "=A1=A203"

However the more I think about this the more I think it's probably not the best idea.

You are going to end up with a whole lot of data that's not going to be particularly easy to interpret.

Can you send me a sample workbook?

Nothing confidential, and nothing too big 0 just something that's representative.

Some sort of mock-up of what the end result might be useful as well.

 

[Lorlai]

All right, thanks to Norie's suggestion and code I've come up with a much better solution than my initial cell by cell comparison. I just need a little bit more help to make this work.

If I type into a cell

=IF(A1=A2,A1,"!" & A1)

I get the values that I want. I need a way to copy this down in the same way that Norie's code worked before. I have tried:

Sub BooleanTest()


Dim wsnew As Worksheet
    Set wsnew = Worksheets.Add
 
    ' copy current data onto new worksheet
    Worksheets("Current").Range("A1:BC200").Copy wsnew.Range("A1")
 
    ' copy previous data onto new worksheet, below the current data with 2 rows inbetween
 
    Worksheets("Previous").Range("A1:BC200").Copy wsnew.Range("A" & Rows.Count).End(xlUp).Offset(3)
 
    ' enter formula's to the right of current data, with 2 columns inbetween
 
    wsnew.Range("A1:BC200").Offset(, wsnew.Cells(1, Columns.Count).End(xlToLeft).Column + 2).Formula = [B]"=IF(A1=A203,A1,'!' & A1)"[/B]
End Sub

But get a "Application or object-defined error".

This is so close to being finished! How can I make the above code work?

Thank you!!

 

[Norie]

Lorlai

Where are you getting the error?

Did you change the code I originally posted to reflect your worksheet names, ranges etc?

You've definitely got the idea I was trying to exlain, just sounds like the code needs a bit of work.

Actually I've just had another look and I think I can see what the problem is - the single quotes around the exclamation mark in the formula

You actually need double quotes and you need to 'double' those up in the code.

Try this for the formula:

"=IF(A1=A203,A1,""!"" & A1)"

 

[Lorlai]

Norie my Friend, I owe you a big plate of cookies when this is all said and done! You are truly a rock star!

With your infinite wisdom, do you know of a good way to use my "primary key" of Positioning ID to check if records had been added or deleted? I had the bare bones of one started (My biggest concern was getting to this point where you have gotten me, THANK YOU THANK YOU again!!! ) which I seem to have lost, but in pseudo-code looked a little like:

Select Previous Sheet
Select Cell AB1 'Positioning ID
Select Current Sheet
Select Cell AB1 'Positioning ID
Loop Until Cell is Empty
Select Previous Sheet
Active Cell one Down
Copy Value to dimmed variable "IDcheck"
Select Current Sheet
Active Cell one Down
Compare Value to variable IDcheck
If Current Value Doesn't equal IDcheck Then
Insert row Current sheet
Active Cell Down one
End if
Loop

What I want it to do is compare the IDs, and if the id is in Current, but not in Previous, then it was deleted from previous and Previous needs a new row. Likewise, if the ID is in Previous, but not in Current, then it was deleted from current and Current needs a new row.

Do you know of a good way to write this out?


You are such a lifesaver!! Thank you for all of your help so far!

 

[Lorlai]

And one more quick question: I won't know the number of rows in each sheet. I know there is a way to find the last row of data in a spreadsheet, but can't seem to recall how to do this, nor how to incorporate this into your formula. Any idea how to do this, so that I can have this be dynamic, as opposed to only grabbing the first 200 rows of data?

Thank you!!