VB Efficiency: Inserting a Row

T

Tippy

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

===========
 
T

Trevor Shuttleworth

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
 
F

Frank Kabel

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
 
S

steveB

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
 
B

Bob Phillips

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 said:
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
Click to expand...
 
T

Tippy

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
 
D

Dana DeLouis

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
 
S

steveB

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
 
B

Bob Phillips

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 said:
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
Click to expand...
 
Top