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

 

[Norie]

Lorlai

Glad you've got it sorted, at least this part.

Finding the last row isn't to difficult but I'm not sure what you mean exactly with the IDs.

The part that's confusing is the 'location' thing.

What's the connection between location and ID?

 

[Lorlai]

The ID field name is "Positioning ID", sorry to confuse matters. The more important part is to 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.


Previous
1.A
2.B
3.D
4.E
5.F
6.G

Current
1.A
2.B
3.C
4.D
5.F
6.G

End Results

Previous
1.A
2.B
3.Insert Row
4.D
5.E
6.F

Current
1.A
2.B
3.C
4.D
5. Insert Row
6. F

Is this a little clearer?

 

[Norie]

Are you just inserting rows to line up the two sets of data?

 

[Lorlai]

Yes, that's it exactly

 

[Norie]

Well I don't think you really need to, and doing it might get complicated.

There might be a better approach eg extracting all the records which have the same ID in both sets of data.

You then compare those records field my field.

All the other records which don't have a matching record in the other data set have been either added or deleted.

I think that makes sense.

 

[Lorlai]

Interesting....How would you go about extracting records with matching IDs?

Your mind goes places that I wouldn't even begin to consider! Thank you for helping me with this!!

 

[Norie]

You could extract the IDs, combine them in one column, add this formula next to that column

=COUNTIF($A$2:$A$2000, A2)

this will return 2 for any ID that appears twice in the combined list.

An ID will only appear twice if it's in Current and Version.

So if we filter this list to return all the IDs whose count is 2 we'll end up with a list of all the IDs that appear in both sets of data.

By the way can I ask you something I should have asked you right at the start, do you have Access?

 

[Lorlai]

Hi Norie,

I took a little break from this headache and am ready to get back in full swing!!

I do have access, but am trying to keep this only in excel to keep it easy for the user.

I have an idea of what I need to do to figure out the duplicate situation, but need a little help figuring it out.

Here is code that works for data on two different sheets. There are two variable, PValue and CValue, that are compared. If they do not match, a row is inserted on the sheet that contains the larger value. For example, if the values are 123 on the current sheet and 456 on the previous sheet, the previous will have a row inserted above the 456.

Do
Sheets("Previous").Select
PValue = ActiveCell.Value
Sheets("Current").Select
CValue = ActiveCell.Value
If PValue <> CValue Then
    If PValue > CValue Then
    Sheets("Previous").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    End If

    If CValue > PValue Then
    Sheets("Current").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    End If
    
    If IsEmpty(PValue) And IsEmpty(CValue) Then
    Exit Sub
    End If
End If

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

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

 
Loop Until IsEmpty(ActiveCell)

This works perfectly, but I am again running into the size of the data. This took about 15 min to run when given 9,000 rows to compare bouncing back and forth across sheets.

My thinking is that I can still use the two sets of data on one worksheet on top of one another, like you had awesomely suggested with the true/false values. Then I can compare these down the column like so:

Column Current
A1.1
A2.2
A3.3
A4.4
A5.5
A6.7

Column Previous
A12.1
A13.2
A14.4
A15.5
A16.6
A17.7

Column Current Output
A1.1
A2.2
A3.3
A4.4
A5.5
A6.BLANK
A7.7


Column Previous Output
A12.1
A13.2
A14.BLANK
A15.4
A16.5
A17.6
A18.7


Where the output columns replace the original columns.

My problem is I can't figure out how to compare the ranges down the column in a loop. To start of, compare A1 to A12, then if they match, go down one, compare A2 to A13, and so on down the column. Do you know of good way to do this?

 

[Lorlai]

Just kidding; typing that novel of the previous post helped me figure out that question. The code to compare the rows in a column is:

Dim PPID As Range
Dim CPID As Range
Dim i As Integer
Dim PValue As String
Dim CValue As String

i =0
Set PPID = Range ("A1")
Set CPID = Range("A30")

Do

PPID.Select
PValue =ActiveCell.Value

CPID.Select
CValue = ActiveCell.Value

If PValue <> CValue Then
    If PValue > CValue Then
    PPID.Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    End If

    If CValue > PValue Then
    CPID.Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    End If
End If

CPID = CPID.Offset(1 + i, 0).Select
PPID = PPID.Offset(1 + i, 0).Select

Loop Until IsEmpty(Activecell)

However, this still takes as long as comparing sheet by sheet.

Is there a way to do a lookup? For example, if the columns are:
Column Current
A1.1
A2.2
A3.3
A4.4
A5.5
A6.7

Column Previous
A12.1
A13.2
A14.4
A15.5
A16.6
A17.7

Have a column next to it with the true/false
B1.TRUE (A1 = A12)
B2.TRUE (A2 = A13)
B3.FALSE (A3 = A14)
B4.FALSE (A4 = A15)
B5.FALSE (A5 = A16)
B6.TRUE (A6 = A17)

And if the value is false, lookup the cells in the formula? Like for B3, the value is FALSE, would it be possible to jump to cells A3 and A14 and compare those values, and since A14 contains a larger value, insert a row, then go back to looking for a False. Does this make sense? Would this be possible to incorporate?

 

[Norie]

Did you not try what I suggested in the last post?

Inserting rows is not going to work very well.

It could get pretty messy - all that selecting/inserting etc means you could even be comparing the wrong rows or even missing rows.

This could all be done in Access with some very simple queries and the order of the rows wouldn't matter at all.

Is there a reason you don't want to use Access?

What is the overall result you are trying to achieve for the user?

Would it be acceptable to use Access to actually do the work but output the results to Excel for the user?

Also the queries I was thinking of in Access might only take seconds.