| Home |
| Search |
| Today's Posts |
|
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Speeding Up Code
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 |
|
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Speeding Up Code
Excel is *SLOOOOOOOOOW* when it comes to writing cell-by-cell.
What you could do is use the ClipBoard object: a) build a line separating the new values with a tab character b) select the destination line (i.e. range) c) paste from the clipboard Dutch " wrote: 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 |
|
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Speeding Up Code
For starters...
Declare all variables. Turn off calculation. Use object variables. Eliminate unnecessary/conflicting code lines. Jim Cone San Francisco, USA '----------------------------- Sub TransData() Dim StartTime As Single Dim EndTime As Single Dim NextRow As Long Dim LastBidItem As Long Dim LastCol As Long Dim C As Long Dim R As Long Dim ProjectNumber As Variant Dim BidItem As String Dim RRT As Excel.Worksheet Set RRT = Worksheets("Revised Rate Table") StartTime = Timer Application.Calculation = xlCalculationManual Application.ScreenUpdating = False RRT.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 RRT.Cells(NextRow, 2).Value = Cells(R, 2).Value RRT.Cells(NextRow, 3).Value = Cells(R, 4).Value RRT.Cells(NextRow, 6).Value = Cells(R, C).Value RRT.Cells(NextRow, 1).Value = ProjectNumber If RRT.Cells(NextRow, 6).Value = " " Then ' GoTo 10 ElseIf RRT.Cells(NextRow, 6).Value < 1 Then RRT.Cells(NextRow, 6).NumberFormat = "0.00" ElseIf Sheets("Revised Rate Table").Cells(NextRow, 6).Value 1 Then RRT.Cells(NextRow, 6).NumberFormat = "0" 10 End If NextRow = NextRow + 1 End If Next R Next C Set RRT = Nothing Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True EndTime = Timer 'MsgBox ("StartTime " & StartTime & " EndTime " & EndTime) MsgBox "It took " & EndTime - StartTime & " seconds" End Sub '---------------------- wrote in message oups.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 |
|
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Speeding Up Code
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 wrote in message oups.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 |
|
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Speeding Up Code
Hey, you decreased my run time from a number of hours to a number of
seconds. Thanks a bunch! Have a great day! |
|
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Speeding Up Code
Looks like all you needed was to turn off calculation.
the other changes are of trivial benefit at best. Application.Calculation = xlCalculationManual existing code. Application.Calculation = xlCalculationAutomatic -- Regards, Tom Ogilvy wrote in message oups.com... Hey, you decreased my run time from a number of hours to a number of seconds. Thanks a bunch! Have a great day! |
|
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Speeding Up Code
What is number format:
NumberFormat = "[<1]0.00;0" i.e., what does this part do [<1] ? To me it looks the same as "0.00" so I am trying to learn its uses, thanks. Bill "Tom Ogilvy" wrote in message ... 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 wrote in message oups.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 |
|
#8
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Speeding Up Code
If the number is less than one, then format as 0.00. If greater than or
equal to 1 format as 0 -- Regards, Tom Ogilvy "William Benson" wrote in message ... What is number format: NumberFormat = "[<1]0.00;0" i.e., what does this part do [<1] ? To me it looks the same as "0.00" so I am trying to learn its uses, thanks. Bill "Tom Ogilvy" wrote in message ... 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 wrote in message oups.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 |
|
#9
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Speeding Up Code
Thanks, that is something I can use too!
"Tom Ogilvy" wrote in message ... If the number is less than one, then format as 0.00. If greater than or equal to 1 format as 0 -- Regards, Tom Ogilvy "William Benson" wrote in message ... What is number format: NumberFormat = "[<1]0.00;0" i.e., what does this part do [<1] ? To me it looks the same as "0.00" so I am trying to learn its uses, thanks. Bill "Tom Ogilvy" wrote in message ... 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 wrote in message oups.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 |
| Reply |
| Thread Tools | Search this Thread |
| Display Modes | |
|
|
Similar Threads
|
||||
| Thread | Forum | |||
| Speeding Up A Spreadsheet | Excel Discussion (Misc queries) | |||
| help with speeding this up... | Excel Programming | |||
| speeding up vlookup | Excel Programming | |||
| Online Resources for Speeding Up Code | Excel Programming | |||
| speeding up a macro | Excel Programming | |||
Linear Mode
