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