Home Menu

Menu


ExcelBanter » Excel Newsgroups » Excel Programming > Speeding up macros
Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 1
Default Speeding up macros

Does anyone know how I could speed up the following:

Dim wks1 As Worksheet
Dim wks2 As Worksheet
Dim iRow As Long
Dim FirstRow As Long
Dim LastRow As Long
Dim res As Variant

Set wks1 = Worksheets("travel1")
Set wks2 = Worksheets("travel2")

With wks2
FirstRow = 1
LastRow = .Cells(.Rows.Count, "k").End(xlUp).Row


For iRow = LastRow To FirstRow Step -1
res = Application.Match(.Cells(iRow, "b").Value, _
wks1.Range("a:a"), 0)

If IsError(res) Then
MsgBox "error"
Exit Sub
End If

wks1.Cells(res, 3).Insert Shift:=xlToRight
wks1.Cells(res, 3).Value = .Cells(iRow, "k").Value

With wks2
FirstRow = 1
LastRow = .Cells(.Rows.Count, "l").End(xlUp).Row

res = Application.Match(.Cells(iRow, "d").Value, _
wks1.Range("a:a"), 0)


wks1.Cells(res, 3).Insert Shift:=xlToRight
wks1.Cells(res, 3).Value = .Cells(iRow, "l").Value

'delete no good
Sheets("error").Select
Range("C4:H100").Select
Selection.Interior.ColorIndex = xlNone
Range("B3").Select
Selection.AutoFill Destination:=Range("B3:B4"),
Type:=xlFillDefault
Range("B3:B4").Select
Range("B4").Select
Selection.AutoFill Destination:=Range("B4:B100"),
Type:=xlFillDefault
Range("B4:B100").Select


If IsError(res) Then
MsgBox "error"
Exit Sub
End If

End With
Next iRow
End With
End Sub


Any help would be appreciated because they are very slow!

Thanks!


--
phil2006
------------------------------------------------------------------------
phil2006's Profile: http://www.excelforum.com/member.php...o&userid=35092
View this thread: http://www.excelforum.com/showthread...hreadid=556822

Reply With QuoteReply With Quote
  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 459
Default Speeding up macros
Nel post
*phil2006* ha scritto:

Does anyone know how I could speed up the following:

Dim wks1 As Worksheet
Dim wks2 As Worksheet
Dim iRow As Long
Dim FirstRow As Long
Dim LastRow As Long
Dim res As Variant

Set wks1 = Worksheets("travel1")
Set wks2 = Worksheets("travel2")

With wks2
FirstRow = 1
LastRow = .Cells(.Rows.Count, "k").End(xlUp).Row


For iRow = LastRow To FirstRow Step -1
res = Application.Match(.Cells(iRow, "b").Value, _
wks1.Range("a:a"), 0)

If IsError(res) Then
MsgBox "error"
Exit Sub
End If

wks1.Cells(res, 3).Insert Shift:=xlToRight
wks1.Cells(res, 3).Value = .Cells(iRow, "k").Value

With wks2
FirstRow = 1
LastRow = .Cells(.Rows.Count, "l").End(xlUp).Row

res = Application.Match(.Cells(iRow, "d").Value, _
wks1.Range("a:a"), 0)


wks1.Cells(res, 3).Insert Shift:=xlToRight
wks1.Cells(res, 3).Value = .Cells(iRow, "l").Value

'delete no good
Sheets("error").Select
Range("C4:H100").Select
Selection.Interior.ColorIndex = xlNone
Range("B3").Select
Selection.AutoFill Destination:=Range("B3:B4"),
Type:=xlFillDefault
Range("B3:B4").Select
Range("B4").Select
Selection.AutoFill Destination:=Range("B4:B100"),
Type:=xlFillDefault
Range("B4:B100").Select


If IsError(res) Then
MsgBox "error"
Exit Sub
End If

End With
Next iRow
End With
End Sub


Any help would be appreciated because they are very slow!

Thanks!

Place this two lines after the Dims:

Application.ScreenUpdating =False
Application.Calculation =xlCalculationManual

your code

And before End Sub place this two more lines:

Application.ScreenUpdating =True
Application.Calculation = xlCalculationAutomatic


--
Hope I helped you.

Thanks in advance for your feedback.

Ciao

Franz Verga from Italy


Reply With QuoteReply With Quote
  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 4,391
Default Speeding up macros
Phil,
Use of .Select is seldom necessary. So
Sheets("error").Select
Range("C4:H100").Select
Selection.Interior.ColorIndex = xlNone
can become
Sheets("error").Range("C4:H100").Interior.ColorInd ex = xlNone
etc...

NickHK

"phil2006" wrote in
message ...

Does anyone know how I could speed up the following:

Dim wks1 As Worksheet
Dim wks2 As Worksheet
Dim iRow As Long
Dim FirstRow As Long
Dim LastRow As Long
Dim res As Variant

Set wks1 = Worksheets("travel1")
Set wks2 = Worksheets("travel2")

With wks2
FirstRow = 1
LastRow = .Cells(.Rows.Count, "k").End(xlUp).Row


For iRow = LastRow To FirstRow Step -1
res = Application.Match(.Cells(iRow, "b").Value, _
wks1.Range("a:a"), 0)

If IsError(res) Then
MsgBox "error"
Exit Sub
End If

wks1.Cells(res, 3).Insert Shift:=xlToRight
wks1.Cells(res, 3).Value = .Cells(iRow, "k").Value

With wks2
FirstRow = 1
LastRow = .Cells(.Rows.Count, "l").End(xlUp).Row

res = Application.Match(.Cells(iRow, "d").Value, _
wks1.Range("a:a"), 0)


wks1.Cells(res, 3).Insert Shift:=xlToRight
wks1.Cells(res, 3).Value = .Cells(iRow, "l").Value

'delete no good
Sheets("error").Select
Range("C4:H100").Select
Selection.Interior.ColorIndex = xlNone
Range("B3").Select
Selection.AutoFill Destination:=Range("B3:B4"),
Type:=xlFillDefault
Range("B3:B4").Select
Range("B4").Select
Selection.AutoFill Destination:=Range("B4:B100"),
Type:=xlFillDefault
Range("B4:B100").Select


If IsError(res) Then
MsgBox "error"
Exit Sub
End If

End With
Next iRow
End With
End Sub


Any help would be appreciated because they are very slow!

Thanks!


--
phil2006
------------------------------------------------------------------------
phil2006's Profile:
http://www.excelforum.com/member.php...o&userid=35092
View this thread: http://www.excelforum.com/showthread...hreadid=556822



Reply With QuoteReply With Quote
  #4   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 5,302
Default Speeding up macros
Hi Phil,

As Nick points out selections are rarely nrcessary and are usually
undesirable. Additionally, as Franz indicates, you could turn off the screen
refresh.

You may also wish to turn off automatic calculation.

Additionally, you have duplicated code blocks and you appear to repeat a
single operation (namely the autofill) in each loop.

Try, therefo

'=============
Public Sub Tester003()
Dim wks1 As Worksheet
Dim wks2 As Worksheet
Dim iRow As Long
Dim FirstRow As Long
Dim LastRow As Long
Dim res As Variant
Dim CalcMode As Long

With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

Set wks1 = Worksheets("travel1")
Set wks2 = Worksheets("travel2")

With wks2
FirstRow = 1
LastRow = .Cells(.Rows.Count, "k").End(xlUp).Row


For iRow = LastRow To FirstRow Step -1
res = Application.Match(.Cells(iRow, "b").Value, _
wks1.Range("a:a"), 0)

If IsError(res) Then
MsgBox "error"
Exit Sub
End If

wks1.Cells(res, 3).Insert Shift:=xlToRight
wks1.Cells(res, 3).Value = .Cells(iRow, "k").Value
Next iRow
End With

'delete no good
With Sheets("error")
.Range("C4:H100").Interior.ColorIndex = xlNone
.Range("B3").AutoFill Destination:=.Range("B3:B4"), _
Type:=xlFillDefault
.Range("B4").AutoFill Destination:=Range("B4:B100"), _
Type:=xlFillDefault
End With

XIT:
With Application
.Calculation = CalcMode
.ScreenUpdating = True
End With

End Sub
'<<=============



--
---
Regards,
Norman



"phil2006" wrote in
message ...

Does anyone know how I could speed up the following:

Dim wks1 As Worksheet
Dim wks2 As Worksheet
Dim iRow As Long
Dim FirstRow As Long
Dim LastRow As Long
Dim res As Variant

Set wks1 = Worksheets("travel1")
Set wks2 = Worksheets("travel2")

With wks2
FirstRow = 1
LastRow = .Cells(.Rows.Count, "k").End(xlUp).Row


For iRow = LastRow To FirstRow Step -1
res = Application.Match(.Cells(iRow, "b").Value, _
wks1.Range("a:a"), 0)

If IsError(res) Then
MsgBox "error"
Exit Sub
End If

wks1.Cells(res, 3).Insert Shift:=xlToRight
wks1.Cells(res, 3).Value = .Cells(iRow, "k").Value

With wks2
FirstRow = 1
LastRow = .Cells(.Rows.Count, "l").End(xlUp).Row

res = Application.Match(.Cells(iRow, "d").Value, _
wks1.Range("a:a"), 0)


wks1.Cells(res, 3).Insert Shift:=xlToRight
wks1.Cells(res, 3).Value = .Cells(iRow, "l").Value

'delete no good
Sheets("error").Select
Range("C4:H100").Select
Selection.Interior.ColorIndex = xlNone
Range("B3").Select
Selection.AutoFill Destination:=Range("B3:B4"),
Type:=xlFillDefault
Range("B3:B4").Select
Range("B4").Select
Selection.AutoFill Destination:=Range("B4:B100"),
Type:=xlFillDefault
Range("B4:B100").Select


If IsError(res) Then
MsgBox "error"
Exit Sub
End If

End With
Next iRow
End With
End Sub


Any help would be appreciated because they are very slow!

Thanks!


--
phil2006
------------------------------------------------------------------------
phil2006's Profile:
http://www.excelforum.com/member.php...o&userid=35092
View this thread: http://www.excelforum.com/showthread...hreadid=556822



Reply With QuoteReply With Quote
  #5   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 1
Default Speeding up macros

Thanks very much

--
phil200
-----------------------------------------------------------------------
phil2006's Profile: http://www.excelforum.com/member.php...fo&userid=3509
View this thread: http://www.excelforum.com/showthread.php?threadid=55682

Reply With QuoteReply With Quote
Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes
Linear Mode Linear Mode

Posting Rules
Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On

Similar Threads
Thread Thread Starter Forum Replies Last Post
Speeding up calculations sb1920alk Excel Discussion (Misc queries) 10 October 10th 06 09:46 PM
Speeding Up A Spreadsheet SamuelT Excel Discussion (Misc queries) 2 June 16th 06 10:04 PM
Speeding up Array gti_jobert[_123_] Excel Programming 10 June 13th 06 03:32 PM
Need help speeding this up KD[_5_] Excel Programming 0 March 24th 06 05:17 PM
help with speeding this up... Simon Excel Programming 16 April 26th 05 03:25 AM


All times are GMT +1. The time now is 08:30 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"

 

Contact Us ExcelBanter forum home Privacy Statement