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