Help needed to speed code up
 

Hi all,
I have code below that i got of this site to compare columns "L" & "H"
and put the difference in "K" if no value in "L" then nothing. However
the code is very slow on large spreadsheets of more than 5000 lines.
Could somebody please help to improve the code to make it work faster ??


Sub InsPriceDiff()
'
Dim rng As Range, cell As Range
Dim mynum As Variant
Dim i As Long
Dim numRows As Long
Dim LastRow As Long
Set rng = Range(Range("H4"), Range("H4").End(xlDown))
For Each cell In rng
If cell.Offset(0, 4) < cell.Value And Not
IsEmpty(cell.Offset(0, 4)) Then
mynum = cell.Offset(0, 0) - cell.Offset(0, 4)
cell.Offset(0, 3) = mynum
End If
Next
End Sub


Les Stout

*** Sent via Developersdex http://www.developersdex.com ***

Help needed to speed code up
 

Les,

You don't need Offset(0,0), that is meaningless, so you could change

mynum = cell.Offset(0,0) - cell.Offset(0, 4)
to
mynum = cell - cell.Offset(0, 4)

You also turn off screenupdating and automatic calculation


Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

and reset after


Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

or even do a different way

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Range("K4").Formula = "=H4-L4"
Range("K4").AutoFill Range("K4").Resize(Range("H4").End(xlDown).Row - 3)
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True


--

HTH

RP
(remove nothere from the email address if mailing direct)


"Les Stout" wrote in message
...
Hi all,
I have code below that i got of this site to compare columns "L" & "H"
and put the difference in "K" if no value in "L" then nothing. However
the code is very slow on large spreadsheets of more than 5000 lines.
Could somebody please help to improve the code to make it work faster ??


Sub InsPriceDiff()
'
Dim rng As Range, cell As Range
Dim mynum As Variant
Dim i As Long
Dim numRows As Long
Dim LastRow As Long
Set rng = Range(Range("H4"), Range("H4").End(xlDown))
For Each cell In rng
If cell.Offset(0, 4) < cell.Value And Not
IsEmpty(cell.Offset(0, 4)) Then
mynum = cell.Offset(0, 0) - cell.Offset(0, 4)
cell.Offset(0, 3) = mynum
End If
Next
End Sub


Les Stout

*** Sent via Developersdex http://www.developersdex.com ***

Help needed to speed code up
 

"Les Stout" wrote in message
...
Hi all,
I have code below that i got of this site to compare columns "L" & "H"
and put the difference in "K" if no value in "L" then nothing. However
the code is very slow on large spreadsheets of more than 5000 lines.
Could somebody please help to improve the code to make it work faster ??


Sub InsPriceDiff()
'
Dim rng As Range, cell As Range
Dim mynum As Variant
Dim i As Long
Dim numRows As Long
Dim LastRow As Long
Set rng = Range(Range("H4"), Range("H4").End(xlDown))
For Each cell In rng
If cell.Offset(0, 4) < cell.Value And Not
IsEmpty(cell.Offset(0, 4)) Then
mynum = cell.Offset(0, 0) - cell.Offset(0, 4)
cell.Offset(0, 3) = mynum
End If
Next
End Sub

I tried your macro with my "H" and "L" 5000 rows long.
It took 92 seconds to execute.
Adding two lines Application ... time was <0.5 seconds.

=====================================
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Set rng = Range(Range("H4"), Range("H4").End(xlDown))
For Each cell In rng
If cell.Offset(0, 4) < cell.Value And Not IsEmpty(cell.Offset(0,
4)) Then
mynum = cell.Offset(0, 0) - cell.Offset(0, 4)
cell.Offset(0, 3) = mynum
End If
Next
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
=====================================

Be aware you should add an ErrorHandler routine
because, should an error occur in the core code,
between the four application lines, you'll remain with
Application.ScreenUpdating = False.

Ciao
Bruno

Help needed to speed code up
 

Thanks Bob, will try it out.

best regards,

Les Stout

*** Sent via Developersdex http://www.developersdex.com ***