Sub TransData1()
'
Dim StartTime As Single, EndTime As Single
Dim rng As Range, rng1 As Range
Dim rng2 As Range, rng3 As Range
Dim rng4 As Range, rng5 As Range
Dim rng6 As Range, rng7 As Range
StartTime = Timer
Application.ScreenUpdating = False
Dim BidItem As String
Sheets("Revised Rate Table").Activate
Range("A:G").ClearContents
nextrow = Range("A65532").End(xlUp).Row + 1
Sheets("Rate Data").Activate
LastBidItem = Range("A65532").End(xlUp).Row
Lastcol = Range("IV2").End(xlToLeft).Column
Lastcol = 20
LastBidItem = 50

Set rng1 = Cells(2, 2).Resize(LastBidItem - 1, 1)
Set rng2 = Cells(2, 4).Resize(LastBidItem - 1, 1)

r = nextrow
For c = 7 To Lastcol
ProjectNumber = Cells(1, c).Value
Set rng4 = Cells(2, c).Resize(LastBidItem - 1, 1)
With Sheets("Revised Rate Table")
Set rng5 = .Cells(r, 1).Resize(LastBidItem - 1, 1)
Set rng6 = .Cells(r, 2).Resize(LastBidItem - 1, 1)
Set rng7 = .Cells(r, 3).Resize(LastBidItem - 1, 1)
Set rng3 = .Cells(r, 6).Resize(LastBidItem - 1, 1)
rng5.Value = ProjectNumber
rng6.Value = rng1.Value
rng7.Value = rng2.Value
rng3.Value = rng4.Value
rng3.NumberFormat = "[<1]0.00;0"
End With
r = r + LastBidItem - 1
Next

Application.ScreenUpdating = True
EndTime = Timer
msgbox (EndTime - StartTime & " secs")
End Sub

--
Regards,
Tom Ogilvy

<robbywvut@hotmail.com> wrote in message
news:1125410182.383615.104830@g47g2000cwa.googlegroups.com...
> Hey guys, any suggestions on how I can speed up this MS Excel (2003
> with XP) macro? Suggestions are welcomed.
>
> Sub TransData()
> '
> StartTime = Time
> Application.ScreenUpdating = False
> Dim BidItem As String
> Sheets("Revised Rate Table").Activate
> NextRow = Range("A65532").End(xlUp).Row + 1
> Sheets("Rate Data").Activate
> Lastbiditem = Range("A65532").End(xlUp).Row
> LastCol = Range("IV2").End(xlToLeft).Column
> LastCol = 20
> Lastbiditem = 50
> For c = 7 To LastCol
> ProjectNumber = Cells(1, c).Value
> For r = 2 To Lastbiditem
> If Cells(r, c).Value <> "" Then
> Sheets("Revised Rate Table").Cells(NextRow, 2).Value = Cells(r,
> 2).Value
> Sheets("Revised Rate Table").Cells(NextRow, 3).Value = Cells(r,
> 4).Value
> Sheets("Revised Rate Table").Cells(NextRow, 6).Value = Cells(r,
> c).Value
> Sheets("Revised Rate Table").Cells(NextRow, 1).Value =
> ProjectNumber
> If Sheets("Revised Rate Table").Cells(NextRow, 6).Value = " "
> Then
> GoTo 10
> ElseIf Sheets("Revised Rate Table").Cells(NextRow, 6).Value <
> 1 Then
> Sheets("Revised Rate Table").Cells(NextRow, 6).NumberFormat
> = "0.00"
> ElseIf Sheets("Revised Rate Table").Cells(NextRow, 6).Value >
> 1 Then
> Sheets("Revised Rate Table").Cells(NextRow, 6).NumberFormat
> = "0"
> 10 End If
> NextRow = NextRow + 1
> End If
> Next r
> Next c
> Application.ScreenUpdating = True
> EndTime = Time
> MsgBox ("StartTime " & StartTime & " EndTime " & EndTime)
> End Sub
>