Excel 2013 not responding while running macro

S

splask

New Member
Joined
Apr 14, 2010
Messages
4
Hi,

My Company recently changed our platform from WinXP to W7, and from Office 2003 to Office 2013.

On our old platform my macros worked fine, on the new platform it runs a couple of loops before Excel suddenly stop responding.
Here I have the option to not touch the computer for about an hour, then it will come back to life, or kill the process in the task manager.

I tried to find a solution and one of them worked somewhat fine but I'm looking for a better one since this is more of a work-around. If I insert the line
Code: 
Application.Wait Now + TimeSerial(0, 0, 1)
in every loop then the code run without causing Excel to stop responding. But it runs slower since it stops for a second each time it loops.

The Excel is running in 32bit but Win7 is 64bit. The issue occur in all excel files where I have macros with loops where data is processed.
I have already tried to disable multi-threaded calculations (not sure about the exact phrase since I use a Swedish version), I've tried saving them to the new excel format as well as tried them locally on the computer instead of on the network.

I'm happy to try almost every solution to be able to solve the issue, the question is does anyone have any suggestions?

Thank you in advance!
 

Excel Facts

What does custom number format of ;;; mean?
Three semi-colons will hide the value in the cell. Although most people use white font instead.
Sort by date Sort by votes
Can you post the code?

One major difference between XL2003 and XL2007+ is the number of rows.
XL2003 had 65536
XL2007+ has 1048576

If your macro is looping through ALL rows, then in XL2007+ is doing over a Million rows, while XL2003 only had to do about 65 thousand.
 
Last edited:
Upvote 0
Thank you for your reply!

I'm not looping through all lines within Excel so that is not the issue.

Here is the code anyway:

Code: 
Option Base 1

Sub A_Fixa_Användare_ID_Anstnr_TIP()


Application.ScreenUpdating = False
Dim år As Integer, månad As Integer
Dim anstnr As Long, kst As Long

Sheets("TIP Data").Select
Cells.Clear

Dim sokvag As String


With Application.FileDialog(msoFileDialogFilePicker)
    .AllowMultiSelect = False
    .ButtonName = "Importera"
    .Title = "Välj TIP-fil att importera"
    ingknapp = .Show
End With

If ingknapp = -1 Then
    sokvag = Application.FileDialog( _
            msoFileDialogFilePicker).SelectedItems(1)
Else
       
        Exit Sub
End If
   
    
    Workbooks.OpenText Filename:= _
        sokvag, Origin:=xlMSDOS, StartRow _
        :=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
        ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False _
        , Space:=False, Other:=False
  
    Selection.Copy
    ActiveWindow.ActivateNext
    Sheets("TIP Data").Select
    Range("A1").Select
    ActiveSheet.Paste
    ActiveWindow.ActivateNext
    Application.EnableEvents = False
    Application.CutCopyMode = False
    ActiveWindow.Close (False)
    Application.EnableEvents = True


Sheets("TIP Data").Select
If Range("b1") = "Screener performance comparision - global" Then år = Left(Range("b3"), 4): månad = Mid(Range("b3"), 6, 2)
If Range("a1") = "Screener Performance Comparison" Then år = Left(Range("b3"), 4): månad = Mid(Range("b3"), 6, 2)

On Error Resume Next

Sheets("Tip Data").Select

If Range("b1") = "Screener performance comparision - global" Then
            år = Left(Range("b3"), 4)
            månad = Mid(Range("b3"), 6, 2)
            Range("A5").Select
            Range(Selection, Selection.End(xlDown)).Select
            Range(Selection, Selection.End(xlToRight)).Select
            Selection.Sort Key1:=Range("B5"), Order1:=xlAscending, Header:=xlNo, _
                OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
                DataOption1:=xlSortNormal
            Range("A5").Select
            
            Do Until ActiveCell = ""

                Application.StatusBar = ActiveCell.Row
                Namn = ActiveCell
                anstnr = ActiveCell.Offset(0, 1)
                Do Until Not ActiveCell.Offset(0, 1) = anstnr Or ActiveCell = ""
                
                    Shift = ActiveCell.Offset(0, 2) + Shift
                    tid = ActiveCell.Offset(0, 3) + tid
                    Väskor = ActiveCell.Offset(0, 9) + Väskor
                    tip = ActiveCell.Offset(0, 10) + tip
                    Hit = ActiveCell.Offset(0, 11) + Hit
                    fal = ActiveCell.Offset(0, 12) + fal
                    RT = ActiveCell.Offset(0, 17) + RT
                    FT = ActiveCell.Offset(0, 18) + FT
                    räknare = räknare + 1
                    ActiveCell.Offset(1, 0).Select
                    If ActiveCell = "Totals" Then ActiveCell.Offset(1, 0).Select
                    If ActiveCell = "Averages" Then ActiveCell.Offset(1, 0).Select
                Loop
                
                Sheets("Sammanställning").Select
                Range("a2").Select
                
                Do Until ActiveCell = ""
                    If ActiveCell = anstnr Then
                        If ActiveCell.Offset(0, 1) = år Then
                            If ActiveCell.Offset(0, 2) = månad Then Exit Do
                        End If
                    End If
                    ActiveCell.Offset(1, 0).Select
                Loop
                
                Application.Wait Now + TimeSerial(0, 0, 1) '''Here is the first wait I inserted and this loop works fine with it

                If ActiveCell.Offset(0, 0) = "" Then ActiveCell = anstnr
                If ActiveCell.Offset(0, 1) = "" Then ActiveCell.Offset(0, 1) = år
                If ActiveCell.Offset(0, 2) = "" Then ActiveCell.Offset(0, 2) = månad
                If ActiveCell.Offset(0, 4) = "" Then ActiveCell.Offset(0, 4) = Namn
                If ActiveCell.Offset(0, 5) = "" Then
                    ActiveCell.Offset(0, 5) = ActiveCell.Offset(0, 4)
                    ActiveCell.Offset(0, 4) = ""
                    Do Until Left(ActiveCell.Offset(0, 5), 1) = " "
                        ActiveCell.Offset(0, 4) = ActiveCell.Offset(0, 4) & Left(ActiveCell.Offset(0, 5), 1)
                        ActiveCell.Offset(0, 5) = Right(ActiveCell.Offset(0, 5), Len(ActiveCell.Offset(0, 5)) - 1)
                    Loop
                    ActiveCell.Offset(0, 5) = Right(ActiveCell.Offset(0, 5), Len(ActiveCell.Offset(0, 5)) - 1)
                End If
                ActiveCell.Offset(0, 11) = 0.01
                ActiveCell.Offset(0, 14) = ((1 * tip) / tip) - (Hit / tip)
                ActiveCell.Offset(0, 15) = RT / räknare
                ActiveCell.Offset(0, 15).NumberFormat = "0.00"
                ActiveCell.Offset(0, 16) = FT / räknare
                ActiveCell.Offset(0, 16).NumberFormat = "0.00"
                ActiveCell.Offset(0, 17) = Shift
                ActiveCell.Offset(0, 18) = tip
                ActiveCell.Offset(0, 19) = Väskor
                ActiveCell.Offset(0, 21) = tid
                
                If Not Hit = 0 Then
                    ActiveCell.Offset(0, 12) = Hit / tip
                Else
                    ActiveCell.Offset(0, 12) = 0
                End If
                If Not fal = 0 Then
                    ActiveCell.Offset(0, 13) = fal / Väskor
                Else
                    ActiveCell.Offset(0, 13) = 0
                End If
                
                If ActiveCell.Offset(0, 12) = 0# Then
                    If Not ActiveCell.Offset(0, 13) = 0# Then
                        x = 0.01
                        y = ActiveCell.Offset(0, 13)
                    Else
                        GoTo nästa
                    End If
                Else
                x = ActiveCell.Offset(0, 12)
                y = ActiveCell.Offset(0, 13)
                End If
                
                If x = 1 Then x = 0.99
                If y = 1 Then y = 0.99
                If y <= 0.01 Then y = 0.01
                
                With Application.WorksheetFunction
                    Result = .NormInv(x, 0, 1) - .NormInv(y, 0, 1)
                End With
                
                ActiveCell.Offset(0, 10) = Result
                ActiveCell.Offset(0, 12) = ActiveCell.Offset(0, 12) * 100
                ActiveCell.Offset(0, 13) = ActiveCell.Offset(0, 13) * 100
                ActiveCell.Offset(0, 14) = ActiveCell.Offset(0, 14) * 100
                
nästa:

                
                Shift = 0
                tid = 0
                Väskor = 0
                tip = 0
                Hit = 0
                fal = 0
                RT = 0
                FT = 0
                räknare = 0
                Sheets("Tip Data").Select
            Loop
            
            
            
End If
'****************************************** TIP Datavis rapport
If Range("a1") = "Screener Performance Comparison" Then
            
            Sheets("TIP Data").Select
            
            år = Left(Range("B6"), 4)
            månad = Mid(Range("b6"), 6, 2)
            
            Range("b9").Select
            
            Do Until Not ActiveCell.Offset(0, -1) = "Mean"
                
                Application.StatusBar = ActiveCell.Row
                anstnr = ActiveCell.Offset(0, 0)
                Namn = ActiveCell.Offset(0, 1)
                d = ActiveCell.Offset(0, 2)
                a = ActiveCell.Offset(0, 3)
                Hit = ActiveCell.Offset(0, 4)
                FA = ActiveCell.Offset(0, 5)
                Miss = ActiveCell.Offset(0, 6)
                RT_Hit = ActiveCell.Offset(0, 7)
                RT_FA = ActiveCell.Offset(0, 8)
                Work = ActiveCell.Offset(0, 9)
                tip = ActiveCell.Offset(0, 10)
                Bags = ActiveCell.Offset(0, 11)
                ActiveCell.Offset(1, 0).Select
                
                Sheets("Sammanställning").Select
                Range("a2").Select
                
                Do Until ActiveCell = ""
                
                    Application.Wait Now + TimeSerial(0, 0, 1)

                    If ActiveCell = anstnr Then
                    
                        If ActiveCell.Offset(0, 1) = år Then
                            If ActiveCell.Offset(0, 2) = månad Then Exit Do
                        End If
                    End If
                    ActiveCell.Offset(1, 0).Select
                Loop
            
                If ActiveCell.Offset(0, 0) = "" Then ActiveCell = anstnr
                If ActiveCell.Offset(0, 1) = "" Then ActiveCell.Offset(0, 1) = år
                If ActiveCell.Offset(0, 2) = "" Then ActiveCell.Offset(0, 2) = månad
                If ActiveCell.Offset(0, 4) = "" Then ActiveCell.Offset(0, 4) = Namn
                ActiveCell.Offset(0, 10) = d
                ActiveCell.Offset(0, 11) = a
                ActiveCell.Offset(0, 12) = Hit
                ActiveCell.Offset(0, 13) = FA
                ActiveCell.Offset(0, 14) = Miss
                ActiveCell.Offset(0, 15) = RT_Hit
                ActiveCell.Offset(0, 16) = RT_FA
                ActiveCell.Offset(0, 17) = Work
                ActiveCell.Offset(0, 18) = tip
                ActiveCell.Offset(0, 19) = Bags
                
                Sheets("TIP Data").Select
                
            Loop

End If

Tutor_Nivå = 2
tid = 1
D1 = 3
D2 = 2.75
Tippar = 20

Sheets("Sammanställning").Select
Range("g2").Select

Do Until ActiveCell.Offset(0, -ActiveCell.Column + 1) = ""

Application.Wait Now + TimeSerial(0, 0, 1)

If ActiveCell.Offset(0, 0) = "" Then ActiveCell.Offset(0, 0) = 0
If ActiveCell.Offset(0, 1) < tid Then ActiveCell.Offset(0, 1).Interior.ColorIndex = 3
If ActiveCell.Offset(0, 1) = "" Then ActiveCell.Offset(0, 1) = 0
If ActiveCell.Offset(0, 2) = "" Then ActiveCell.Offset(0, 2) = 0
If ActiveCell.Offset(0, 3) = "" Then ActiveCell.Offset(0, 3) = 0
If ActiveCell.Offset(0, 4) = "" Then ActiveCell.Offset(0, 4) = 0
If ActiveCell.Offset(0, 5) = "" Then ActiveCell.Offset(0, 5) = 0
If ActiveCell.Offset(0, 6) = "" Then ActiveCell.Offset(0, 6) = 0
If ActiveCell.Offset(0, 7) = "" Then ActiveCell.Offset(0, 7) = 0
If ActiveCell.Offset(0, 8) = "" Then ActiveCell.Offset(0, 8) = 0
If ActiveCell.Offset(0, 9) = "" Then ActiveCell.Offset(0, 9) = 0
If ActiveCell.Offset(0, 10) = "" Then ActiveCell.Offset(0, 10) = 0
If ActiveCell.Offset(0, 11) = "" Then ActiveCell.Offset(0, 11) = 0
If ActiveCell.Offset(0, 12) = "" Then ActiveCell.Offset(0, 12) = 0
If ActiveCell.Offset(0, 12) < Tippar Then ActiveCell.Offset(0, 12).Interior.ColorIndex = 45
If ActiveCell.Offset(0, 13) = "" Then ActiveCell.Offset(0, 13) = 0
ActiveCell.Offset(1, 0).Select
Loop



Sheets("KST från HR+").Select

Range("a2").Select

Do Until ActiveCell = ""
Application.Wait Now + TimeSerial(0, 0, 1)

    Application.StatusBar = ActiveCell.Row & "     " & ActiveCell.Text
    anstnr = ActiveCell
    kst = ActiveCell.Offset(0, 5)
    ActiveCell.Offset(1, 0).Select
    
    Sheets("Sammanställning").Select
    Range("a2").Select
    Do Until ActiveCell = ""
    
        If ActiveCell = anstnr Then
            
            If ActiveCell.Offset(0, 20) = "" Then ActiveCell.Offset(0, 20) = kst
            
        End If
        
        ActiveCell.Offset(1, 0).Select
    Loop
    
    
    Sheets("KST från HR+").Select
Loop
Sheets("Sammanställning").Select
 Columns("H:H").Select
    Selection.Replace What:=".", Replacement:=",", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
Range("F2").Select
Do Until ActiveCell.Offset(0, -5) = ""
    
Application.Wait Now + TimeSerial(0, 0, 1)

    If ActiveCell = "" Then
        Do Until Right(ActiveCell.Offset(0, -1), 1) = " "
            ActiveCell = Right(ActiveCell.Offset(0, -1), 1) & ActiveCell
            ActiveCell.Offset(0, -1) = Left(ActiveCell.Offset(0, -1), Len(ActiveCell.Offset(0, -1)) - 1)
        Loop
        ActiveCell.Offset(0, -1) = Left(ActiveCell.Offset(0, -1), Len(ActiveCell.Offset(0, -1)) - 1)
        
    End If
    ActiveCell.Offset(1, 0).Select

Loop
Application.ScreenUpdating = True
Sheets("TIP Data").Select
Cells.Clear

Sheets("Sammanställning").Select
End sub
 
Upvote 0
Are you working with large fields of data? You've got a lot of .Selects in there, some within Do loops. Those selects can be eliminated, it'll take some time and work on your part but it will speed it up, especially if you have big chunks of data as it's incrementing its way down through each individual row.
 
Upvote 0
I have a couple suggestions.
1 is very easy, the other will take some heavy re-writing of your code.

1. You've already disabled Screenupdating, that's a start.
But you can also disable events and calculation. Calculation is a big contributer to slow code.

So at the beginning, you can do

Rich (BB code): 
With Application
    .ScreenUpdating = False
    .EnableEvents = False
    PrevCalc = .Calculation
    .Calculation = xlCalculationManual
End With

Then at the end to turn it all back on
Rich (BB code): 
With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = PrevCalc
End With


And number 2..
It's really all the Selecting that is making your code slow.
I would imagine it wasn't really 'fast' to begin with in XL2003.
But the time it took was tolerable.
This is what will take some serious effort and re-writing to correct.


Example, here you're starting by selecting a cell, then doing a loop untill the activecell = ""
Then just selecting the next cell as you go through the loop.
Rich (BB code): 
Range("A5").Select
            Do Until ActiveCell = ""
            'Then alot of references to ActiveCell like
            Namn = ActiveCell
            anstnr = ActiveCell.Offset(0, 1)
            'Then selecting the next cell and looping
            ActiveCell.Offset(1, 0).Select
            Loop

This is VERY inefficient, even with screenupdating turned off.


Instead, create a variable that finds the last used row, and do a loop with a variable incrimenting from 5 to that number.
And use Cells(i,"A") instead of ActiveCell

Something like
Rich (BB code): 
lastrow = Cells(Rows.Count,"A").End(xlup).Row
For i = 5 to lastrow
    'Now you can use Cells(i,"A") instead of ActiveCell
    Namn = Cells(i, "A")
    anstnr = Cells(i, "A").Offset(0,1)
Next i


Hope that helps.
 
Upvote 0
j_harr said:
Are you working with large fields of data? You've got a lot of .Selects in there, some within Do loops. Those selects can be eliminated, it'll take some time and work on your part but it will speed it up, especially if you have big chunks of data as it's incrementing its way down through each individual row.
Click to expand...

Well yes, I think most people would call it large fields of data. I should be able to remove one of the loops by simply insert a Lookup formula to all cells within a column. That would speed up the process regardless of the issue with the excel not responding. So thank you for that, it will be a nice addition to the code. Unfortunately not all the selections can be eliminated inside the loops but I can minimize the size of the loop from all cells with content within the sheet to just the ones that are being added during the macro running. You gave me some nice ideas to optimize the code, now I just need to know how to prevent the not responding part.

I can't get it why it stops responding in Excel 2013 and not in 2003.
 
Upvote 0
Thank you Jonmo1! I'll try to turn off the calculation and re-write the code as you suggested. If a few hours of re-writing will get my codes running and save a couple of minutes each time, then I'll save many more hours later.

And yes, the code ran in 2003 but it took some time before it finished, though Excel never stopped responding.
I hope the combination of your suggestions works for me. Unfortunately this is just one of a whole bunch of files :) But now I have something to work with!
 
Upvote 0
Glad to help


Also, this bit..
Application.StatusBar = ActiveCell.Row

While I understand it's a nice idea to show the user that progress is being made..
In all honesty, it just contributes more to the slowness of the code.

You have to weigh the cost vs benifit of that little progress indicator.

Instead, you might just give a popup message box at the very beginning of the code saying
"be patient dude, this might take a minute or so." or whatever.
Then they click ok and let it run.
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

D
  • Question
Excel keeps Not Responding
Replies
0
Views
337
DiscoPistol
D
D
  • Solved
Macro that won't run Trying to use DoWhile Loop and Offset to compare cells
Replies
8
Views
208
Micron
M
E
  • Question
Old XLSM files crashing Excel; looking for help to troubleshoot, please
Replies
9
Views
966
jkpieterse
jkpieterse
C
  • Question
This is an Excel to Access porting issue - Is it possible to convert an Excel VBA FIND method to work correctly in and with Access's VBA ?
4 5 6
Replies
50
Views
1K
Trebor76
T
D
  • Question
Saving workbook "hides" macros
Replies
2
Views
356
dotsent
D

Forum statistics

Threads
1,214,591
Messages
6,120,427
Members
448,961
Latest member
nzskater

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top