Mr. Nyro
Mr. Nyro

Reputation: 11

Excel not responding when executing macro

I'm kind of new to programming and I don't really know much about debuggin in specific. I currently facing a problem with this code. It makes excel not responding for around 15 min when executed.

What I´m looking for is to have date extracted from wb(ZTP Tracker Sharepoint) and look if there is an entry into another wb (Warning Tracker) within 5 days, then return Yes or No.

Have a look at the actual code:

Sub warning_lookup()

Sheets("Summary").Select

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Application.DisplayAlerts = False

For cell = 2 To 1001

    Value = Cells(cell, 3)
    If Cells(cell, 5) = "Yes" Or Cells(cell, 5) = "No" Then
        If Cells(cell, 5) = "Yes" Then
            For Each x In ['Warning Tracker'!A:A]
                If x.Value = Value Then
                    If Sheets("Warning Tracker").Cells(x.Row, 3) > Cells(cell, 4) - 1 And Sheets("Warning Tracker").Cells(x.Row, 3) < Cells(cell, 4) + 6 Then
                        Cells(cell, 6) = "Yes"
                    End If
                End If
            Next
        End If

        If Cells(cell, 5) = "No" Then
            Cells(cell, 6) = ""
        Else: If Cells(cell, 6) = isblank Then Cells(cell, 6) = "No"

        End If
    End If
Next

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.DisplayAlerts = True
Application.CutCopyMode = False

End Sub

Upvotes: 1

Views: 85

Answers (3)

CLR
CLR

Reputation: 12289

It's not responding due to the sheer amount of work you've asked it to do, while screen updating is off and without giving you any indication that something is happening.

Assuming you're running this in Excel 2007 or later, you've created a loop that potentially compares the contents of 3 cells against another 3 cells a full 1,048,576,000 times. (1001-2+1 cells x 1,048,576 cells in large loop + 1001-2+1 more after)

That's potentially 3.15 billion cell comparisons. Taking the steps laid out by others below reduces the iterations of the loop which could speed things up a lot, depending on the amount of dead space in the ranges.

Other things to consider would be to:

  • Load the ranges being compared into arrays which are a lot quicker for comparisons than cells.
  • Create a progress indicator using the status bar so the user doesn't start thinking Excel has crashed.
  • Perform a DoEvents occasionally, every X number of comparisons. This'll allow other things to happen that might otherwise cause the user to think things have gone wrong.

Upvotes: 1

Shai Rado
Shai Rado

Reputation: 33692

You have a couple of things which might cause errors (or freeze up your PC)

  1. If Cells(cell, 6) = isblank is not a valid VBA syntax, it should be If IsEmpty(Cells(cell, 6)) Then.

  2. Looping through entire column "A:A" will take forever:

replace your:

For Each x In ['Warning Tracker'!A:A]

to a loop where there is actual data:

For Each x In Sheets("Warning Tracker").Range("A1:A" & Sheets("Warning Tracker").Cells(Sheets("Warning Tracker").Rows.Count, "A").End(xlUp).Row)

Try replacing you loop with the code below (there's no need to Select the sheet, you can use With Sheets("Summary") instead):

Code

With Sheets("Summary")
    For cell = 2 To 1001

        Value = .Cells(cell, 3)
        If .Cells(cell, 5) = "Yes" Then
            For Each x In Sheets("Warning Tracker").Range("A1:A" & Sheets("Warning Tracker").Cells(Sheets("Warning Tracker").Rows.Count, "A").End(xlUp).Row)
                If x.Value = Value Then
                    If Sheets("Warning Tracker").Cells(x.Row, 3) > .Cells(cell, 4) - 1 And Sheets("Warning Tracker").Cells(x.Row, 3) < .Cells(cell, 4) + 6 Then
                        .Cells(cell, 6) = "Yes"
                    End If
                End If
            Next
        End If

        If .Cells(cell, 5) = "No" Then
            .Cells(cell, 6) = ""
        Else
            If IsEmpty(.Cells(cell, 6)) Then .Cells(cell, 6) = "No"
        End If
    Next
End With

Upvotes: 1

JNevill
JNevill

Reputation: 50273

My best guess is that this line:

  For Each x In ['Warning Tracker'!A:A]

Is taking forever. You are saying "For each Cell in the entire column of A". In Excel 2007 or newer, that is over 1 million cells it has to check to see if x.value = Value.

Change your for loop to something more restrictive:

  For each x in Range("A1:A50000")

You could also have the program figure out what that 50000 should be each time it runs:

 Dim lastRow as integer
 lastRow = Range("A999999").end(xlUp).Row
 For each x in Range("A1:A" & lastRow)
     ....

In this example the variable lastRow will hold the last row on the worksheet that has a value in Column A.

Also, your syntax looks very odd on a few lines.

  1. Else: If is sort of funky. That Colon should not be there. (perhaps this works, but I've never seen it before)
  2. isblank is not a thing in VBA. isBlank is being treated as variable with no value in this case, so it might be working by accident...?
  3. Your nested if statements can be combined into one. This isn't necessarly a bad thing, but all this nesting can lead to hard to read code.

Example of combining nested ifs:

If Cells(cell, 5) = "Yes" Or Cells(cell, 5) = "No" Then
    If Cells(cell, 5) = "Yes" Then

Could be:

If (Cells(cell, 5) = "Yes" Or Cells(cell, 5) = "No") AND Cells(cell, 5) = "Yes" Then

Upvotes: 3

Related Questions