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

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/

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/

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/

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/

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

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/

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/

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/