Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Westi on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Optimizing VBA Excel Code 3

Status
Not open for further replies.

Stretchwickster

Programmer
Apr 30, 2001
1,746
GB
The following code takes an age to execute. Is there any way to speed it up?
Code:
  Dim i as integer

  for i = 3 to 52
    Workbooks("WorkbookA").Worksheets(1).Cells(i, 2).Copy _
     Workbooks("WorkbookB").Worksheets("Work3").Cells(6, i + 3)
  next i

Clive [infinity]
Ex nihilo, nihil fit (Out of nothing, nothing comes)
 
Doesn't look bad to me. How fast is your computer? Memory issues? Lots of other stuff open?

Have you considered just using an external reference to the source data?

 
450MHz 256MB RAM.

I neglected to mention that the cells at the destination are used to make 1000s of other calculations - is this what is taking the time?

>>Have you considered just using an external reference to the source data?
Can you explain this a bit more i.e. details on how to set it up.


Clive [infinity]
Ex nihilo, nihil fit (Out of nothing, nothing comes)
 
yeh - that'd probably do it - it's probably calculating on every loop
try
application.calculation = xlcalculationmanual
before the loop and
application.calculation = xlcalculationautomatic
application.calculate
after the loop


Rgds
Geoff
Si hoc legere scis, nimis eruditionis habes
 
Clive, at the risk of piling on, you can do it this way even faster:
[blue]
Code:
Sub CopyStuff()
  Workbooks("WorkbookA.xls").Worksheets(1) _
       .Range("B3:B52").Copy
  Workbooks("WorkbookB.xls").Worksheets("Work3") _
       .Range("F6").PasteSpecial Transpose:=True
  Application.CutCopyMode = False
End Sub
[/color]

 
Cheers Zathras that worked a treat and looks much tidier!
Just one further question. Could I do the following without using a loop?
Code:
  With ActiveSheet
    For i = 3 To 52
      .Cells(7, 3 + i).Value = "=RADIANS(" & .Cells(7, 3 + i).Value & ")"
    Next i
  End With

Sorry to be a pain but I'm trying to improve my VBA coding.

Clive [infinity]
Ex nihilo, nihil fit (Out of nothing, nothing comes)
 
Hi Stretch
This may not be exactly what you are after but bear with me
Code:
Range("C7:BA7").FormulaR1C1 = "=RADIANS(R[-1]C)"
(range is a guess!)

This takes the row above the row with the formula for the argument. Your code I don't think will work anyway as it should generate a circular reference.

Happy Friday
;-)

If a man says something and there are no women there to hear him, is he still wrong? [ponder]
 
Loomah that won't work (circular reference) - my intention is to prefix the already existing value with "=RADIANS(" and add a suffix ")" which my code successfully does. Any other suggestions?

Clive [infinity]
Ex nihilo, nihil fit (Out of nothing, nothing comes)
 
Clive, here are a couple of variations on the theme:

Simple way to do the same thing:
[blue]
Code:
Option Explicit
Sub demo1()
Dim c As Range
  For Each c In Range("F7:BC7")
    c.FormulaR1C1 = "=RADIANS(" & c.Value & ")"
  Next c
End Sub
[/color]

BTW, it is a good practice to use [blue]
Code:
Option Explicit
[/color]
as the first line in every code module. It causes the compiler to reject any variables that have not been explicitly defined. Good way to catch spelling errors.

If you don't like the letters for columns, here is an alternative:
[blue]
Code:
Sub demo2()
Dim c As Range
  For Each c In Range(Cells(7, 6), Cells(7, 55))
    c.FormulaR1C1 = "=RADIANS(" & c.Value & ")"
  Next c
End Sub
[/color]


Since I know the quality of your work in the Delphi forum, I offer this version for you to consider. It handles the case where the current contents of any cell is already a formula. (BTW, if they are all constants, why turn them into formulas? Just replace each value with another value.) It also avoids burying "magic numbers" deep in the code, by declaring constants at the top. (Depending on the circumstance, they could be Dimmed as variables.)
[blue]
Code:
Sub demo3()
Const ROW_TARGET = 7
Const COL_FIRST = 6
[green]
Code:
 ' Column "G"
[/color]
Code:
Const COL_LAST = 55
[green]
Code:
 ' Column "BC"
[/color]
Code:
Dim r As Range
Dim c As Range
  Set r = Range(Cells(ROW_TARGET, COL_FIRST), Cells(ROW_TARGET, COL_LAST))
  For Each c In r
    If c.HasFormula Then
      c.Formula = "=RADIANS(" & Mid(c.Formula, 2, 999) & ")"
    Else
      c.Value = WorksheetFunction.Radians(c.Value)
    End If
  Next c
  Set r = Nothing
End Sub
[/color]

 
Stretch
I realise now what you mean, I didn't read the code properly first time round. I have a feeling it isn't possible, though I stand to be corrected by anybody knowing better!

I've not really got close - only able to add the first value to all the formulas or create circular references!

So at this stage "I'll get me coat"

Good Luck
;-)

If a man says something and there are no women there to hear him, is he still wrong? [ponder]
 
Zathras,

Thank you very much - that is a very helpful lowdown - just what I was looking for. If I could give you a second star I would! I like it cos it's very neat, tidy and readable and answers some queries about looping through ranges that I've had in the past. The only part I don't fully understand is the following:
Code:
  c.Formula = "=RADIANS(" & Mid(c.Formula, 2, 999) & ")"
What's confusing me is the Mid statement - is this code trying to grab all but the "=" sign that already exists in the formula? I guess by setting the length to 999 you are ensuring that you catch the rest of the formula?

Clive [infinity]
Ex nihilo, nihil fit (Out of nothing, nothing comes)
 
I think I now know where my confusion lay. I was thinking that if c has a formula (e.g. =RADIANS(90)) then your code would be doing =RADIANS(RADIANS(90)) which would be a bit pointless.

But I guess you were considering the scenario whereby c has a formula: =90. Which now makes complete sense! Thanks for your (yet again!) comprehensive help on this one - you can tell it's the end of the week (my brain feels like a prune!) ;-)

Clive [infinity]
Ex nihilo, nihil fit (Out of nothing, nothing comes)
 
It IS neat and tidy and makes good use of variables and control structures. So I gave him another star.
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top