Code running EXTREMELY slow. Please help!

minette

Board Regular
Joined
Jul 8, 2005
Messages
237
I have this code which is running on about 55000 rows of data. It is running extremely slow, and I cannot run the line "For n = 1 to 55000" in one. I keep getting the "overflow" error. So I break it down into 5000's. E.g. "For n = 1 - 5000" and then "For n = 5001 to 10000" etc, etc. But getting closer to the end of the file it is running slower and slower, where at some point I have to break even that down to 500's etc. This is unworkable. I know my code is not fantastic, so does anyone have any pointers that would help in this case?

Code:
Sub Test()
Dim n As Integer

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim starttime As Date
Dim endtime As Date
starttime = Now()

For n = 1 To 55000
    If Range("D" & n) = "Commercial Centre" Or Range("D" & n) = "Commercial Southend" Then Range("J" & n) = "Comm"
    If Range("D" & n) = "Perel" Then Range("J" & n) = "DA"
    If Range("W" & n) = "" And Range("A" & n) <> "Complete" Then Range("W" & n) = "Work in Progress"
    If Range("W" & n) = "" And Range("A" & n) = "Complete" Then Range("W" & n) = "Closed"
    If Range("O" & n) = "" And Range("A" & n) = "Complete" Then Range("O" & n).FormulaR1C1 = "=EOONTH(NOW(),0)"
    If Left(Range("F" & n), 2) = "OM" Or Left(Range("G" & n), 2) = "PV" Then Range("D" & n) = "Perel"
    If Left(Range("F" & n), 2) = "OM" Or Left(Range("G" & n), 2) = "PV" Then Range("J" & n) = "DA"
    If Left(Range("G" & n), 2) = "OM" Or Left(Range("G" & n), 2) = "PV" Then Range("D" & n) = "Perel"
    If Left(Range("G" & n), 2) = "OM" Or Left(Range("G" & n), 2) = "PV" Then Range("J" & n) = "DA"
    If Range("F" & n) = "" And Range("G" & n) <> "" Then Range("F" & n) = Range("G" & n)
    If Range("F" & n) = "" And Range("G" & n) = "" Then Range("F" & n) = "Not Known"
    If Range("F" & n) = "Not known" And Range("G" & n) = "" Then Range("G" & n) = "Not Known"

    Range("AM" & n).Select
    ActiveCell.FormulaR1C1 = "=IF(LEN(RC[-33])>40,LEFT(RC[-33],40),RC[-33])"
    ActiveCell.Select
    Selection.Copy
    Range("F" & n).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.Cut
    ActiveSheet.Paste
    
    If Range("A" & n) <> "Complete" Then Range("X" & n) = ""
    If Right(Range("S" & n), 1) = " " Then Range("R" & n) = Left(Range("S" & n), 8)
    If Mid(Range("S" & n), 4, 1) = "n" Then Selection.Replace What:="n", Replacement:=" ", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
    ReplaceFormat:=False
    If Range("S" & n) <> "" Then Range("S" & n) = "NOT KNWN"
    If Left(Range("B" & n), 5) = "CARIL" Then
        Range("AM" & n).FormulaR1C1 = "=IF(LEN(RC[-37])>12,IF(LEFT(RC[-37],5)=""CARIL"",LEFT(RC[-37],12),RC[-37]),RC[-37])"
        Range("AM" & n).Select
        ActiveCell.Select
        Selection.Copy
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Application.CutCopyMode = False
        Selection.Cut
        Range("B" & n).Select
        ActiveSheet.Paste
    ElseIf Left(Range("B" & n), 5) = "IMPRO" Then
        Range("AM" & n).FormulaR1C1 = "=IF(LEN(RC[-37])>11,IF(LEFT(RC[-37],5)=""IMPRO"",LEFT(RC[-37],11),RC[-37]),RC[-37])"
        Range("AM" & n).Select
        ActiveCell.Select
        Selection.Copy
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Application.CutCopyMode = False
        Selection.Cut
        Range("B" & n).Select
        ActiveSheet.Paste
    End If
    Next n

endtime = Now()
Application.ScreenUpdating = True
Application.DisplayAlerts = True
MsgBox "Done: This routine took " & Format(endtime - starttime, "hh:mm:ss") & " secs"
End Sub
 

Excel Facts

Bring active cell back into view
Start at A1 and select to A9999 while writing a formula, you can't see A1 anymore. Press Ctrl+Backspace to bring active cell into view.
Couple of pointers.

1 Declare as Long not Integer.

2 Don't use Select/Selection.

I would also suggest you look into using formulas, inserted via code, rather than looping.:)
 
Upvote 0
Two things I pick up on immediately. If you are copying and pasting values, rather than using all the Select, Copy and Paste commands, just use a single line, something like:
Code:
Range("F" & n).Value = Range("AM" & n).Value

Secondly, the reason you are getting an overflow error is because n is declared as an Integer which is a 16-bit number so can only be a value between plus and minus 32,767. Instead declare it as “Long”:
Code:
Dim n as Long
 
Upvote 0
Lewiy

What about -32,678?:)

Don't tell me MS has removed it.:eek:
 
Upvote 0
Oops! Goood catch! :oops:
My mental arithmetic is not what it once was!!
God forbid we should lose that all important number :LOL:
 
Upvote 0
Hi,

In addition, it is best to avoid reading & writing cells except as one 'lump', below is an untested re-work of your IF conditions:
Code:
Sub xxx()
Dim n As Long
Dim vaCurrentLine As Variant
Dim starttime As Date
Dim endtime As Date

Application.ScreenUpdating = False
Application.DisplayAlerts = False

starttime = Now()

For n = 1 To 55000
    vaCurrentLine = Range("A" & n, "W" & n).Value
    
'    If Range("D" & n) = "Commercial Centre" Or Range("D" & n) = "Commercial Southend" Then Range("J" & n) = "Comm"
'    If Range("D" & n) = "Perel" Then Range("J" & n) = "DA"
    If CStr(vaCurrentLine(1, 4)) = "Commercial Centre" _
    Or CStr(vaCurrentLine(1, 4)) = "Commercial Southend" Then
        vaCurrentLine(1, 10) = "Comm"       'Range("J" & n) = "Comm"
    ElseIf CStr(vaCurrentLine(1, 4)) = "Perel" Then
        vaCurrentLine(1, 10) = "DA"         'Range("J" & n) = "DA"
    End If
    
'    If Range("W" & n) = "" And Range("A" & n) <> "Complete" Then Range("W" & n) = "Work in Progress"
'    If Range("W" & n) = "" And Range("A" & n) = "Complete" Then Range("W" & n) = "Closed"
    If CStr(vaCurrentLine(1, 23)) = "" Then
        If CStr(vaCurrentLine(1, 1)) = "Complete" Then
            vaCurrentLine(1, 23) = "Closed" 'Range("W" & n) = "Closed"
        Else
            vaCurrentLine(1, 23) = "Work in Progress" 'Range("W" & n) = "Work in Progress"
        End If
    End If
    
    
'    If Left(Range("F" & n), 2) = "OM" Or Left(Range("G" & n), 2) = "PV" Then _
'        Range("D" & n) = "Perel"
'    If Left(Range("F" & n), 2) = "OM" Or Left(Range("G" & n), 2) = "PV" Then _
'        Range("J" & n) = "DA"
'    If Left(Range("G" & n), 2) = "OM" Or Left(Range("G" & n), 2) = "PV" Then _
'        Range("D" & n) = "Perel"
'    If Left(Range("G" & n), 2) = "OM" Or Left(Range("G" & n), 2) = "PV" Then _
'        Range("J" & n) = "DA"
    If Left$(vaCurrentLine(1, 6), 2) = "OM" _
    Or Left$(vaCurrentLine(1, 7), 2) = "PV" _
    Or Left$(vaCurrentLine(1, 7), 2) = "OM" Then
        vaCurrentLine(1, 4) = "Perel"   'Range("D" & n) = "Perel"
        vaCurrentLine(1, 10) = "DA"     'Range("J" & n) = "DA"
    End If
    
    
'    If Range("F" & n) = "" And Range("G" & n) <> "" Then Range("F" & n) = Range("G" & n)
'    If Range("F" & n) = "" And Range("G" & n) = "" Then Range("F" & n) = "Not Known"
'    If Range("F" & n) = "Not known" And Range("G" & n) = "" Then Range("G" & n) = "Not Known"
    If CStr(vaCurrentLine(1, 6)) = "" Then
        If vaCurrentLine(1, 7) = "" Then
            vaCurrentLine(1, 6) = "Not Known"
            vaCurrentLine(1, 7) = "Not Known"
        Else
            vaCurrentLine(1, 6) = vaCurrentLine(1, 7)
        End If
    End If
    
    Range("A" & n, "W" & n).Value = vaCurrentLine
    
    '    If Range("O" & n) = "" And Range("A" & n) = "Complete" Then Range("O" & n).FormulaR1C1 = "=EOONTH(NOW(),0)"
    If CStr(vaCurrentLine(1, 15)) = "" _
    And CStr(vaCurrentLine(1, 1)) = "Complete" Then
        Range("O" & n).FormulaR1C1 = "=EOONTH(NOW(),0)"
    End If

    '...... etc .....
    
Next n
End Sub
 
Upvote 0
Hi Guys - this is excellent. All your efforts has helped dramatically. It's now down to 6minutes 30seconds. Wow, can't believe that a few small changes can make such a big difference.
 
Upvote 0
I've discovered a problem with the code above. Even though I thought it was working, on closer inspection, I realised that it was not working correctly. It is not updating values in the spreadsheet. When I watch "vaCurrentLine" in the watch window, the values changes in the watch window, but does not change in the file itself. Does anyone know what could cause this?
 
Upvote 0
Hi,

Possibly
a) the line
Code:
Range("A" & n, "W" & n).Value = vaCurrentLine

isnt getting obeyed,

b) the currently active sheet isnt what you think it is.
c) try commenting out the Application.ScreenUpdating=False to see if that's the problem.

HTH

Alan
 
Upvote 0

Forum statistics

Threads
1,213,531
Messages
6,114,167
Members
448,554
Latest member
Gleisner2

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