Copy/Paste Macro takes ages - How can I speed it up? 3

[MeGustaXL]

Hi There,

I've got this macro which copies the values in cells A4:F4 to H4:M4, then repeats N times, with the number of loops being set by the variable EJECT.

Public Sub DataLogger()
Num_Of_Fails = 0
Num_Of_Runs = 0
System_Reliability = 1
[F4] = 1
EJECT = [G1].Value
Application.ScreenUpdating = False
For N = 1 To EJECT
Calculate
[G4] = N
    If [E4] = 0 Then
        Num_Of_Fails = Num_Of_Fails + 1
        System_Reliability = 1 - (Num_Of_Fails / N)
        [F4] = System_Reliability
        [G5] = Num_Of_Fails
    End If
[A4:F4].Select
Selection.Copy
ActiveCell(N, 8).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
       False, Transpose:=False
Application.CutCopyMode = False
Next N
Application.ScreenUpdating = True
End Sub

The trouble is, even with ScreenUpdating set to False, it takes about 15 minutes on my PC to do 30,000 loops (the average number of runs I require), and the maximum of about 60,000 runs takes a 'Forget-About-It' 45 minutes!

I expect I need to do somthing about all that Selecting, but I'd appreciate any streamlining tips!

Note to the Forum Police - I've also posted this on VBA 5&6 - Sorry!

Chris

Varium et mutabile semper Excel

http://www.insys-ltd.co.uk

 

[xlbo]

do you really need to calculate on every iteration of the loop ?

and yes - get rid of the selecting etc - generally very little need - in fact, do you have to do a paste special ?? if not, you can use the extended copy syntax which bypasses the clipboard....eg:

Range("A1").copy destination:=Range("Z1")

Rgds, Geoff

Three things are certain. Death, taxes and lost data. DPlank is to blame

Please read FAQ222-2244 before you ask a question

 

[Rofeu]

Hi,

why loop at all??

Public Sub DataLogger()
Num_Of_Fails = 0
Num_Of_Runs = 0
System_Reliability = 1
[F4] = 1
eject = [G1].Value
[G4] = eject
    If [E4] = 0 Then
        Num_Of_Fails = Num_Of_Fails + 1
        System_Reliability = 1 - (Num_Of_Fails / N)
        [F4] = System_Reliability
        [G5] = Num_Of_Fails
    End If
    
Range("A4:F4").Copy
Range(Cells(1, 8), Cells(eject, 8)).PasteSpecial Paste:=xlValues
End Sub

Takes me about 1 seconds to paste 60000 lines



Cheers,

Roel

 

[MeGustaXL]

Hi Geoff and Roel, and thanks for your replies

It's a Monte Carlo simulation which resamples failure times in A4:F4 then copies the result to a table in H4:M30004 (or whatever EJECT is). So Yes, I do need to 'Calculate', 'EJECT' times.
Unless you know of another way to generate 30,000 random samples?
The formulas in A4:E4 are

=A$2*(-LN(1-RAND())^(1/A$3))	=IF(A4>E1,1,0)	=C$2*(-LN(1-RAND())^(1/C$3))	=IF(C4>E1,1,0)	=PRODUCT(B4,D4)

Here's some sample data from 10 loops:

289.2769752	1	1559.079896	1	1	1
107.3770561	1	893.3054254	1	1	1
1181.427848	1	1236.103626	1	1	0.666666667
2074.935328	1	405.6185275	1	1	0.666666667
3871.252595	1	97.48325336	1	1	0.666666667
332.313304	1	858.0270136	1	1	0.666666667
1104.465545	1	1035.449168	1	1	0.714285714
107.8248237	1	100.9255382	1	1	0.714285714
842.8006274	1	478.4519047	1	1	0.714285714
104.2685896	1	387.8785103	1	1	0.714285714

Chris

Varium et mutabile semper Excel

http://www.insys-ltd.co.uk

 

[xlbo]

ok then - do you need to paste the values only or could you get away with pasting the cell in its entirety ?

Other than that, you could streamline:

[A4:F4].Select
Selection.Copy
ActiveCell(N, 8).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
       False, Transpose:=False

to

[A4:F4].Copy
ActiveCell(N, 8).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
       False, Transpose:=False
Application.CutCopyMode = False

Generally, anywhere you have a

Object.Select
Selection.PerformAction

you can change it to be

Object.PerformAction

Rgds, Geoff

Three things are certain. Death, taxes and lost data. DPlank is to blame

Please read FAQ222-2244 before you ask a question

 

[MeGustaXL]

Thanks again for your help Geoff

That bombed out with a 400 error whenI tried to do 2,000 iterations
When I looked at the sheet, I saw that the first sample had pasted in H4 as required, but the next was in O5, then V6, etc. until it ran out of sheet! Obviously, O5 is H4 offset by 1 Row, 8 Columns as specified in:

ActiveCell(N, 8).PasteSpecial.......

In Pseudo Code, what I'm Trying to do is this:

[blue]For N = 1 to EJECT
Calculate the formulas in A4:E4
Put a value in F4[/blue]
[red]Copy A4:F4 and paste only the values in the next blank row in column H[/red]
[green]'Could be any column, actually, just so long as it adds the next sample to the bottom of the list[/green]
[blue]Next N
Update a Chart on Another Sheet
Print the Chart
Make a Cuppa
End[/blue]

Now, I'm fine with everything in [blue]blue[/blue], it seems to me that just the [red]red[/red] bit is causing me problems!

How should I syntax it to paste the values into
[H65536].End(xlUp) for instance?

Do you think that might help?

Chris

Varium et mutabile semper Excel

http://www.insys-ltd.co.uk

 

[MeGustaXL]

This works..

[A4:F4].Copy
[b]Range("H65536").End(xlUp).Offset(1, 0)[/b].PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
       False, Transpose:=False
Application.CutCopyMode = False

Hoorah!

But it takes 90 seconds to do 2000 runs - that's 30 seconds longer! BOOOOO!

I'll leave it alone, I think - at least the copy/paste bit worked after a fashion in the original!

Chris

Varium et mutabile semper Excel

http://www.insys-ltd.co.uk

 

[xlbo]

To be honest, for 30,000 iterations, its gonna take a bit of time

Can't speak for the spreadsheet itself - there may be a way to make it calculate more efficiently but other than that, it is not like your code is massively inefficient. To be honest, without changing app or methodology, I'm not sure you can speed it up much given the actions you are trying to perform. Sorry.

Rgds, Geoff

Three things are certain. Death, taxes and lost data. DPlank is to blame

Please read FAQ222-2244 before you ask a question

 

[MeGustaXL]

I Guess you're right, Geoff, but have a STAR anyway for this priceless snippet of advice:

Generally, anywhere you have a
Object.Select
Selection.PerformAction

you can change it to be

Object.PerformAction

As with all of your contributions, clear, concise and instructional!

Chris

Varium et mutabile semper Excel

http://www.insys-ltd.co.uk

 

[xlbo]

no probs - sorry I couldn't be of more help

Rgds, Geoff

Three things are certain. Death, taxes and lost data. DPlank is to blame

Please read FAQ222-2244 before you ask a question

 

[ck1999]

Public Sub DataLogger()
Num_Of_Fails = 0
Num_Of_Runs = 0
System_Reliability = 1
[f4] = 1
eject = [G1].Value
Application.ScreenUpdating = False
For n = 1 To eject
a = [A2] * (-Log(1 - Rnd()) ^ (1 / [A3]))
If a > [e1] Then
b = 1
Else: b = 0
End If
c = [C2] * (-Log(1 - Rnd()) ^ (1 / [C3]))
If c > [e1] Then
d = 1
Else: d = 0
End If
e = b * d
[G4] = n
If e = 0 Then
Num_Of_Fails = Num_Of_Fails + 1
f = 1 - (Num_Of_Fails / n)
[G5] = Num_Of_Fails
End If

Range("h" & n + 3).Value = a
Range("i" & n + 3).Value = b
Range("j" & n + 3).Value = c
Range("k" & n + 3).Value = d
Range("l" & n + 3).Value = e
Range("m" & n + 3).Value = f

Next n
Application.ScreenUpdating = True
End Sub


This code works alot faster 10000 records in 5-7 sec

chris

 

[MeGustaXL]

Hi Chris (SNAP! )

This looks like it'll run like Carl Lewis, but it falls over at the line:

[blue] a = [A2] * (-Log(1 - Rnd()) ^ (1 / [A3]))[/blue]

It gives a Runtime Error '5' - Invalid procedure call or argument.

Because the formula is solving an Exponential function, I changed the 'Log' to 'Ln' and tried again. This time it halts at that line with "Compile Error: Sub or Function not defined"

Then I noticed the 'Rnd()' - surely that should be 'Rnd' without the brackets? So I changed it and..."Compile Error: Sub or Function not defined"

Perhaps it needs to specify the worksheet function, so:

[blue]a = [A2] * (-WorksheetFunction.Ln(1 - Rnd) ^ (1 / [A3]))[/blue]

You guessed it......."Compile Error: Sub or Function not defined"

I KNOW this'll work - we just need the correct syntax!






Chris

Varium et mutabile semper Excel

http://www.insys-ltd.co.uk

 

[rmikesmith]

Chris,

Log is the correct form. From the VBA Help file:
Log Function

Returns a Double specifying the natural logarithm of a number.

Not sure why the error is generated, but assigning the Rnd() function to a variable seems to eliminate this. Example:

Dim R as Double
a = [A2] * (-Log(1 - R)) ^ (1 / [A3])

HTH
Mike

 

[ck1999]

I copied and pasted it out of my VBA and it worked great the way the code was written. What version of excel do you have. I am using 2003.

CK1999

 

[ck1999]

also make sure a2 and a3 are not blank

Ck1999

 

[ck1999]

Try this
a = [A2] * (-Log(1 - Rnd)) ^ (1 / [A3])

Chris

 

[rmikesmith]

Note: I left out the assignment

R = Rnd()

ck1999 -- Not sure if your question was directed to me, but I'm using Excel 2000. Perhaps there is a bug in the Log function. I certainly could see no reason why your version shouldn't work.


Regards,
Mike

 

[ck1999]

Mike,
I am asking Chris however I tested my origional code in excel 97 and it had the same error as chris had. I think their may of been to large of a formula without simplifying it somewhat, The parathesis were messing it up it seemed to me. The new code works now in excel 97.

Chris

 

[rmikesmith]

ck1999 -- Ditto for me on XL2000.


Mike

 

[MeGustaXL]

Chris and Mike,

I prostrate myself at the feet of Giants .... Thank you both

1. Mike - you're right, of course. In VBA-speak 'LOG' is the same as 'LN'. I really must learn to RTFM!

2. Chris - your 'streamlined' code works a treat: 10,000 iterations in 6 seconds

3. Both - apologies for not responding, but I'd gone home when you posted, had enough for one (short) day you see!

4. My initial problem (slow running) was compounded by all the other little intermediate formula cells I had sprinkled over the speadsheet - STDEVs, AVERAGEs and other stats garbage. All of which had to recalculate, based on the growing table of samples, every time the code called for a 'Calculate'! No wonder it was Sloooooow!


Thanks again to everyone - Stars all round

Chris

Varium et mutabile semper Excel

http://www.insys-ltd.co.uk