![]() |
VB Efficiency: Inserting a Row
My VB code takes an absurd amount of time to execute after I ha
expanded the code slightly. Reading previous posts, I think one of th bottle necks is the "Activate" function I use. I have posted the cod below and would appreciate any help on how to make the code mor efficient. I was also wondering where other obvious bottlenecks t consider. Thanks! ============ Public Function insert_row(orig_row, dest_row) As Integer Range("A" & orig_row & ":N" & orig_row).Select Range("B" & orig_row).Activate Selection.Cut Range("A" & dest_row & ":N" & dest_row).Select Range("B" & dest_row).Activate Selection.insert Shift:=xlDown End Function =========== -- Message posted from http://www.ExcelForum.com |
VB Efficiency: Inserting a Row
Tippy
you might try this instead: Public Function insert_row(orig_row, dest_row) As Integer Range("A" & orig_row & ":N" & orig_row).Cut Range("A" & dest_row & ":N" & dest_row).Insert Shift:=xlDown End Function Regards Trevor "Tippy " wrote in message ... My VB code takes an absurd amount of time to execute after I had expanded the code slightly. Reading previous posts, I think one of the bottle necks is the "Activate" function I use. I have posted the code below and would appreciate any help on how to make the code more efficient. I was also wondering where other obvious bottlenecks to consider. Thanks! ============ Public Function insert_row(orig_row, dest_row) As Integer Range("A" & orig_row & ":N" & orig_row).Select Range("B" & orig_row).Activate Selection.Cut Range("A" & dest_row & ":N" & dest_row).Select Range("B" & dest_row).Activate Selection.insert Shift:=xlDown End Function ============ --- Message posted from http://www.ExcelForum.com/ |
VB Efficiency: Inserting a Row
Hi
try Public Function insert_row(orig_row, dest_row) As Integer application.screenupdating=false Range("A" & orig_row & ":N" & orig_row).Cut Range("A" & dest_row & ":N" & dest_row).Insert Shift:=xlDown application.cutcopymode=false application.screenupdating=True End Function -- Regards Frank Kabel Frankfurt, Germany "Tippy " schrieb im Newsbeitrag ... My VB code takes an absurd amount of time to execute after I had expanded the code slightly. Reading previous posts, I think one of the bottle necks is the "Activate" function I use. I have posted the code below and would appreciate any help on how to make the code more efficient. I was also wondering where other obvious bottlenecks to consider. Thanks! ============ Public Function insert_row(orig_row, dest_row) As Integer Range("A" & orig_row & ":N" & orig_row).Select Range("B" & orig_row).Activate Selection.Cut Range("A" & dest_row & ":N" & dest_row).Select Range("B" & dest_row).Activate Selection.insert Shift:=xlDown End Function ============ --- Message posted from http://www.ExcelForum.com/ |
VB Efficiency: Inserting a Row
Don't know how you got a function to cut and insert. Usually a function
will only return a value. But the following code will cut the first range and insert it at the second point. All without select or activate. '''''''''''''''''''''''''''' Range("A" & orig_row & ":N" & orig_row).Cut Range("A" & dest_row).Insert Shift:=xlDown '''''''''''''''''''''''''''' hth -- steveB (Remove 'NOSPAM' from email address if contacting me direct) "Tippy " wrote in message ... My VB code takes an absurd amount of time to execute after I had expanded the code slightly. Reading previous posts, I think one of the bottle necks is the "Activate" function I use. I have posted the code below and would appreciate any help on how to make the code more efficient. I was also wondering where other obvious bottlenecks to consider. Thanks! ============ Public Function insert_row(orig_row, dest_row) As Integer Range("A" & orig_row & ":N" & orig_row).Select Range("B" & orig_row).Activate Selection.Cut Range("A" & dest_row & ":N" & dest_row).Select Range("B" & dest_row).Activate Selection.insert Shift:=xlDown End Function ============ --- Message posted from http://www.ExcelForum.com/ |
VB Efficiency: Inserting a Row
No, a function CAN return something, it doesn't have to. And if it is just
called from VBA, it can cut and insert at will. Tippy, in addition to other advice, you might want to remove the call to the function, as that will also incur an overhead. Incorporate the amended code directly within the loop to speed it up. And then you can turn screenupdating off (Application.ScreenUpdating = False), and set calculation to manual (Application.Calculation = xlCalculateManual). Reset afterwards. -- HTH Bob Phillips ... looking out across Poole Harbour to the Purbecks (remove nothere from the email address if mailing direct) "steveB" wrote in message ... Don't know how you got a function to cut and insert. Usually a function will only return a value. But the following code will cut the first range and insert it at the second point. All without select or activate. '''''''''''''''''''''''''''' Range("A" & orig_row & ":N" & orig_row).Cut Range("A" & dest_row).Insert Shift:=xlDown '''''''''''''''''''''''''''' hth -- steveB (Remove 'NOSPAM' from email address if contacting me direct) "Tippy " wrote in message ... My VB code takes an absurd amount of time to execute after I had expanded the code slightly. Reading previous posts, I think one of the bottle necks is the "Activate" function I use. I have posted the code below and would appreciate any help on how to make the code more efficient. I was also wondering where other obvious bottlenecks to consider. Thanks! ============ Public Function insert_row(orig_row, dest_row) As Integer Range("A" & orig_row & ":N" & orig_row).Select Range("B" & orig_row).Activate Selection.Cut Range("A" & dest_row & ":N" & dest_row).Select Range("B" & dest_row).Activate Selection.insert Shift:=xlDown End Function ============ --- Message posted from http://www.ExcelForum.com/ |
VB Efficiency: Inserting a Row
I made it a function for debugging purposes. I have posted the rest o
my code, which is not too long, but I don't understand why it takes s long to execute. Any thoughts? Thanks for everyone's help! Sub actual() ' number of proposed planes numProp = 5 numPlanes = 54 mu = 20 / (24 * 60) stdev = 20 / (24 * 60) Dim proposed(5) As Integer Sheet4.Range("N2:N55") = Null For i = 1 To numProp Do r = Round(2 + numPlanes * Rnd(), 0) Loop While (search(proposed, r, numProp) < -1 And Sheet4.Range("N & r).Value < "#") proposed(i - 1) = r Sheet4.Range("O" & i).Value = proposed(i - 1) ' for each proposed plane add a normal random variable ' to its ETA eta = Sheet4.Range("K" & r).Value + randn(mu, stdev) ' Reposition the plane based on ETA new_pos = find_pos(r, eta) ' find position for proposed based o new ETA Sheet4.Range("K" & r).Value = eta ' change ETA of proposed Sheet4.Range("N" & r).Value = "#" ' mark as moved Sheet4.Range("P" & 4 * i + 8).Value = eta Sheet4.Range("P" & 4 * i + 9).Value = Sheet4.Range("B" & r).Value Sheet4.Range("P" & 4 * i + 10).Value = new_pos foo = insert_row(r, new_pos) ' put proposed to new position Next i End Sub Public Function find_pos(orig_row, new_eta) As Integer curr_row = orig_row + 1 curr_eta = Sheet4.Range("K" & curr_row).Value While (curr_eta < new_eta And curr_eta < "") curr_row = curr_row + 1 curr_eta = Sheet4.Range("K" & curr_row).Value Wend find_pos = curr_row End Function Public Function insert_row(orig_row, dest_row) As Integer Range("A" & orig_row & ":N" & orig_row).Cut Range("A" & dest_row & ":N" & dest_row).insert Shift:=xlDown End Function Public Function randn(mu, stdev) As Double Range("P1").FormulaR1C1 = "=NORMINV(" & Rnd() & "," & mu & "," & stde & ")" randn = Range("P1").Value End Function Public Function search(arr, e, s) As Integer ' returns the index of the first occurance of e in arr of size s ' returns -1 if not found search = -1 For k = 0 To s - 1 If (arr(k) = e) Then search = k End If Next k End Function Public Function max(a, b) As Double If (a b) Then max = a Else max = b End If End Functio -- Message posted from http://www.ExcelForum.com |
VB Efficiency: Inserting a Row
Would this idea work? Using a Function vs a Sub can be useful if you wish
to return a value indicating the status of the function. For example, returning a "True" would indicate that the function did indeed work as expected. Function MoveRow(FromRow, ToRow) As Boolean On Error Resume Next Rows(FromRow).Cut Rows(ToRow + 1).Insert MoveRow = Err.Number = 0 End Function -- Dana DeLouis Using Windows XP & Office XP = = = = = = = = = = = = = = = = = "Tippy " wrote in message ... My VB code takes an absurd amount of time to execute after I had expanded the code slightly. Reading previous posts, I think one of the bottle necks is the "Activate" function I use. I have posted the code below and would appreciate any help on how to make the code more efficient. I was also wondering where other obvious bottlenecks to consider. Thanks! ============ Public Function insert_row(orig_row, dest_row) As Integer Range("A" & orig_row & ":N" & orig_row).Select Range("B" & orig_row).Activate Selection.Cut Range("A" & dest_row & ":N" & dest_row).Select Range("B" & dest_row).Activate Selection.insert Shift:=xlDown End Function ============ --- Message posted from http://www.ExcelForum.com/ |
VB Efficiency: Inserting a Row
There are a couple of ways to speed things up. One is to turn calculation
off at the beginning of your code and turn it back on at the end. The other is to turn ScreenUpdating off/on Application.ScreenUpdating=False * your code * Application.ScreenUpdating=True. I have found that this greatly improves the speed... Especially when you are inserting/deleting rows or columns... hth -- steveB (Remove 'NOSPAM' from email address if contacting me direct) "Tippy " wrote in message ... I made it a function for debugging purposes. I have posted the rest of my code, which is not too long, but I don't understand why it takes so long to execute. Any thoughts? Thanks for everyone's help! Sub actual() ' number of proposed planes numProp = 5 numPlanes = 54 mu = 20 / (24 * 60) stdev = 20 / (24 * 60) Dim proposed(5) As Integer Sheet4.Range("N2:N55") = Null For i = 1 To numProp Do r = Round(2 + numPlanes * Rnd(), 0) Loop While (search(proposed, r, numProp) < -1 And Sheet4.Range("N" & r).Value < "#") proposed(i - 1) = r Sheet4.Range("O" & i).Value = proposed(i - 1) ' for each proposed plane add a normal random variable ' to its ETA eta = Sheet4.Range("K" & r).Value + randn(mu, stdev) ' Reposition the plane based on ETA new_pos = find_pos(r, eta) ' find position for proposed based on new ETA Sheet4.Range("K" & r).Value = eta ' change ETA of proposed Sheet4.Range("N" & r).Value = "#" ' mark as moved Sheet4.Range("P" & 4 * i + 8).Value = eta Sheet4.Range("P" & 4 * i + 9).Value = Sheet4.Range("B" & r).Value Sheet4.Range("P" & 4 * i + 10).Value = new_pos foo = insert_row(r, new_pos) ' put proposed to new position Next i End Sub Public Function find_pos(orig_row, new_eta) As Integer curr_row = orig_row + 1 curr_eta = Sheet4.Range("K" & curr_row).Value While (curr_eta < new_eta And curr_eta < "") curr_row = curr_row + 1 curr_eta = Sheet4.Range("K" & curr_row).Value Wend find_pos = curr_row End Function Public Function insert_row(orig_row, dest_row) As Integer Range("A" & orig_row & ":N" & orig_row).Cut Range("A" & dest_row & ":N" & dest_row).insert Shift:=xlDown End Function Public Function randn(mu, stdev) As Double Range("P1").FormulaR1C1 = "=NORMINV(" & Rnd() & "," & mu & "," & stdev & ")" randn = Range("P1").Value End Function Public Function search(arr, e, s) As Integer ' returns the index of the first occurance of e in arr of size s ' returns -1 if not found search = -1 For k = 0 To s - 1 If (arr(k) = e) Then search = k End If Next k End Function Public Function max(a, b) As Double If (a b) Then max = a Else max = b End If End Function --- Message posted from http://www.ExcelForum.com/ |
VB Efficiency: Inserting a Row
similar to what I said 2 days ago (sic!)
-- HTH Bob Phillips ... looking out across Poole Harbour to the Purbecks (remove nothere from the email address if mailing direct) "steveB" wrote in message ... There are a couple of ways to speed things up. One is to turn calculation off at the beginning of your code and turn it back on at the end. The other is to turn ScreenUpdating off/on Application.ScreenUpdating=False * your code * Application.ScreenUpdating=True. I have found that this greatly improves the speed... Especially when you are inserting/deleting rows or columns... hth -- steveB (Remove 'NOSPAM' from email address if contacting me direct) "Tippy " wrote in message ... I made it a function for debugging purposes. I have posted the rest of my code, which is not too long, but I don't understand why it takes so long to execute. Any thoughts? Thanks for everyone's help! Sub actual() ' number of proposed planes numProp = 5 numPlanes = 54 mu = 20 / (24 * 60) stdev = 20 / (24 * 60) Dim proposed(5) As Integer Sheet4.Range("N2:N55") = Null For i = 1 To numProp Do r = Round(2 + numPlanes * Rnd(), 0) Loop While (search(proposed, r, numProp) < -1 And Sheet4.Range("N" & r).Value < "#") proposed(i - 1) = r Sheet4.Range("O" & i).Value = proposed(i - 1) ' for each proposed plane add a normal random variable ' to its ETA eta = Sheet4.Range("K" & r).Value + randn(mu, stdev) ' Reposition the plane based on ETA new_pos = find_pos(r, eta) ' find position for proposed based on new ETA Sheet4.Range("K" & r).Value = eta ' change ETA of proposed Sheet4.Range("N" & r).Value = "#" ' mark as moved Sheet4.Range("P" & 4 * i + 8).Value = eta Sheet4.Range("P" & 4 * i + 9).Value = Sheet4.Range("B" & r).Value Sheet4.Range("P" & 4 * i + 10).Value = new_pos foo = insert_row(r, new_pos) ' put proposed to new position Next i End Sub Public Function find_pos(orig_row, new_eta) As Integer curr_row = orig_row + 1 curr_eta = Sheet4.Range("K" & curr_row).Value While (curr_eta < new_eta And curr_eta < "") curr_row = curr_row + 1 curr_eta = Sheet4.Range("K" & curr_row).Value Wend find_pos = curr_row End Function Public Function insert_row(orig_row, dest_row) As Integer Range("A" & orig_row & ":N" & orig_row).Cut Range("A" & dest_row & ":N" & dest_row).insert Shift:=xlDown End Function Public Function randn(mu, stdev) As Double Range("P1").FormulaR1C1 = "=NORMINV(" & Rnd() & "," & mu & "," & stdev & ")" randn = Range("P1").Value End Function Public Function search(arr, e, s) As Integer ' returns the index of the first occurance of e in arr of size s ' returns -1 if not found search = -1 For k = 0 To s - 1 If (arr(k) = e) Then search = k End If Next k End Function Public Function max(a, b) As Double If (a b) Then max = a Else max = b End If End Function --- Message posted from http://www.ExcelForum.com/ |
All times are GMT +1. The time now is 09:19 AM. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com