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!

Nel post news:[email protected]
*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

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.ColorIndex = xlNone
etc...

NickHK

"phil2006" <[email protected]> wrote in
message news:[email protected]...
>
> 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
>

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, therefore:

'=============>>
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" <[email protected]> wrote in
message news:[email protected]...
>
> 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
>

Thanks very much!