Excel 2002 macro does not work in 2003. Code included.

[Deirdre]

Good morning,

I've searched the forums and could not find an answer to my question. I have a large macro that has worked well - perhaps not as well as it could - but it worked nonetheless in 2002. My software has been updated to 2003 (insert laughter) and now that macro seems to hang. I do not receive an error message, but the macro doesn't complete. I suspect it has something to do with the first loop. Your assistance is always very much appreciated.
The workbook starts with 3 sheets called "Baseline", "Audit", and "Hema"

Sub HemaSynch()
'
'
    Dim LR As Long
    Dim rng As Range
    LR = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
    Application.ScreenUpdating = False
    Sheets.Add
    ActiveSheet.Name = "Indeterminate"
    Sheets.Add
    ActiveSheet.Name = "ResolveDuplicates"
    Sheets.Add
    ActiveSheet.Name = "Excludes"
    Sheets("Hema").Select
    For MY_ROWS = 1 To Range("A65536").End(xlUp).Row
    For MY_ROWS_2 = MY_ROWS + 1 To Range("A65536").End(xlUp).Row
        If Range("A" & MY_ROWS).Value = Range("A" & MY_ROWS_2).Value Then
            Range("A" & MY_ROWS).Interior.ColorIndex = 41
            Range("A" & MY_ROWS_2).Interior.ColorIndex = 41
        End If
      Next MY_ROWS_2
    Next MY_ROWS
    Sheets("Baseline").Select
    Cells.Select
    Selection.sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    Range("A1").Select
    Sheets("Audit").Select
    Range("D1").Select
    Selection.EntireColumn.Insert
    Selection.EntireColumn.Insert
    ActiveCell.FormulaR1C1 = "ph"
    Range("E1").Select
    ActiveCell.FormulaR1C1 = "ph"
    Range("F1").Select
    ActiveCell.FormulaR1C1 = "City Name"
    Range("G1").Select
    ActiveCell.FormulaR1C1 = "ST"
    Sheets("Audit").Copy before:=Sheets(1)
    ActiveSheet.Name = "Synch"
    Sheets("Audit").Select
    Cells.Select
    Selection.sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    Range("A1").Select
    LR = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "Baseline"
    Range("D1").Select
    ActiveCell.FormulaR1C1 = "Changed?"
    Range("C2").Select
    Range("C2").Formula = "=VLOOKUP(RC[-2],'Baseline'!C[-2]:C[-1],2,0)"
    Range("C2").AutoFill Destination:=Range("C2:C" & LR)
    Range("D2").Select
    Range("D2").Formula = "=IF(ISNA(RC[-1]),""new"",IF(RC[-2]=RC[-1],""no"",""YES""))"
    Range("D2").AutoFill Destination:=Range("D2:D" & LR)
    Range("E1").Select
    Selection.EntireColumn.Insert
    ActiveCell.FormulaR1C1 = "Comment"
    Cells.Select
    Cells.EntireColumn.AutoFit
    Range("C1:D1").Select
    With Selection.Interior
        .ColorIndex = 11
        .Pattern = xlSolid
    End With
    Selection.Font.ColorIndex = 2
    Selection.Font.Bold = True
    Columns("E:E").Select
    Selection.Delete Shift:=xlToLeft
    Sheets("Synch").Select
    LR = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
    Range("D1").Select
    ActiveCell.FormulaR1C1 = "Hema Entry"
    Range("E1").Select
    ActiveCell.FormulaR1C1 = "Different?"
    Range("D1:E1").Select
    With Selection.Interior
        .ColorIndex = 11
        .Pattern = xlSolid
    End With
    Selection.Font.ColorIndex = 2
    Selection.Font.Bold = True
    Cells.Select
    Cells.EntireColumn.AutoFit
    Range("D2").Select
    Range("D2").Formula = "=VLOOKUP(RC[-3],'Hema'!C[-3]:C[-2],2,0)"
    Range("D2").AutoFill Destination:=Range("D2:D" & LR)
    Range("E2").Select
    Range("E2").Formula = "=IF((LEFT(RC[-3],7))=(LEFT(RC[-1],7)),""no"",""YES"")"
    Range("E2").AutoFill Destination:=Range("E2:E" & LR)
    Cells.Select
    Cells.EntireColumn.AutoFit
    Range("A1").Select
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 1
    Rows("1:1").Select
    Selection.AutoFilter
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 1
    Columns("C:C").Select
    Selection.Delete Shift:=xlToLeft
    Selection.AutoFilter
    Set rng = Range("D1:D" & Cells(Rows.Count, "A").End(xlUp).Row)
    With rng
    .AutoFilter field:=1, Criteria1:="<>YES"
    .Offset(1, 0).EntireRow.Delete
    .AutoFilter
    End With
    Sheets("Audit").Select
    Set rng = Range("D1:D" & Cells(Rows.Count, "A").End(xlUp).Row)
    With rng
    .AutoFilter field:=1, Criteria1:="no"
    .Offset(1, 0).EntireRow.Delete
    .AutoFilter
    End With
    Range("A1").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "ID"
    Range("A1").Select
    Sheets("Audit DMIS").Select
    Sheets("Audit DMIS").Copy before:=Sheets(1)
    ActiveSheet.Name = "Corrections"
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "Change to:"
    Range("E1").Select
    ActiveCell.FormulaR1C1 = "Comment"
    With Selection.Interior
        .ColorIndex = 11
        .Pattern = xlSolid
    End With
    Selection.Font.ColorIndex = 2
    Selection.Font.Bold = True
    Cells.Select
    Cells.EntireColumn.AutoFit
    Range("A1").Select
    Sheets("Audit").Select
    Range("E1").Select
    Selection.EntireColumn.Delete
    Sheets("Corrections").Select
    ActiveWindow.SelectedSheets.Delete
    Sheets("Excludes").Select
    ActiveWindow.SelectedSheets.Delete
    Sheets("Audit").Select
    ActiveWindow.SelectedSheets.Delete
    Sheets.Add
    ActiveSheet.Name = "Workbook Instructions"
    ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.TabRatio = 0.792
    ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
    ActiveWindow.ScrollWorkbookTabs Position:=xlLast
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "Workbook Instruction Guide"
      With ActiveCell.Characters(Start:=1, Length:=26).Font
        .Name = "Arial "
        .FontStyle = "Bold"
        .Size = 14
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = 3
    End With
    Range("A4").Select
    ActiveCell.FormulaR1C1 = _
        "The green colored tabs are your action tabs. These tabs require review and validation by your region."
    Range("A5").Select
    ActiveCell.FormulaR1C1 = _
        "The black colored tabs are for reference only. You may use these tabs to assist your work."
    Range("A7").Select
    ActiveCell.FormulaR1C1 = _
        "Audit Synch: This tab lists those entries in Hemasphere which are not in synch with DMIS. In most cases, it is simply a typo in the ID in Hemasphere. Please research the correct ID in DMIS and alter the ID in Hemasphere to match it."
        ActiveCell.FormulaR1C1 = _
        "Audit Synch: This tab lists those entries in Hema which are not in synch with XXXX. "
    With ActiveCell.Characters(Start:=1, Length:=12).Font
        .Name = "Arial "
        .FontStyle = "Bold"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = 10
    End With
    Sheets("Workbook Instructions").Tab.ColorIndex = 3
    Sheets("Hema").Tab.ColorIndex = 1
    Application.ScreenUpdating = True
   
End Sub

 

[Damon Ostrander]

Hi Deirdre,

It could simply be that the two nested loops are taking a long time to execute. After all, if your sheet contained 1000 rows of data the inner loop would get executed about 500,000 times, and 10000 rows of data would require about 100 times as many inner loop executions. Obviously any increase to the number of rows of data will have a disproportionate (squared) effect on the execution time, so if the number of rows increased at the same time as the change from Excel 2002 to 2003, this is more than likely to be the problem.

I have found that setting the properties and using methods of Shape objects takes much longer with newer versions of Excel because the Microsoft design team keeps making Shape objects more complex, with more properties, etc. Range objects have also become more complex, and since these loops in your code set cell color, this might have something to do with the slowdown.

I recommend you sprinkle STOP statements or break points every 10 lines or so in your code so that you can determine how far the code is executing or whether it is just extremely slow as I suspect. You should be able to quickly narrow down the exact line of code where it is "hanging". If it does turn out to be the loops I recommend you add a statement like

Application.StatusBar = MY_ROWS

to the outer loop so you can see visually the progress of the outer loop in the Excel Status Bar.

I hope this helps.

Damon

 

[Deirdre]

Thank you for the reply Damon.

In an effort to locate the hanging point, I turned on screen updating at the beginning. I also rem'd out the first loop as it is not really necessary any more.

I found the macro seems to be hanging here:

 With rng
    .AutoFilter field:=1, Criteria1:="<>YES"
    .Offset(1, 0).EntireRow.Delete
    .AutoFilter
    End With
    Sheets("Audit").Select
    Set rng = Range("D1:D" & Cells(Rows.Count, "A").End(xlUp).Row)
    With rng
    .AutoFilter field:=1, Criteria1:="no"
    .Offset(1, 0).EntireRow.Delete
    .AutoFilter
    End With

I see where it applies the autofilter but it does not delete and instead just hangs there. When in 2002 the macro completed within a few minutes - the data sets are usually a few thousand rows (< 6k).

 

[Deirdre]

And to add mystery to this...

I just successfully executed the macro in Excel 2007.

/facepalm

 

[RoryA]

Does it make any difference if you set calculation to manual in the code at the start?

 

[Deirdre]

Rorya,

Huzzah! That was it! I turned on manual calc for the part of deleting rows and it now works!

Thank you thank you thank you!