Home | Contact Us | FAQ | Search & Site Map | Link to Us
Sign In | Join | Other 45 Sites in Network
Home
DiscussionsAccessExcelInfoPathOutlookPowerPointPublisherWord
DirectoryUser Groups
Related Topics
Outlook ExpressInternet ExplorerWindowsMS Server ProductsMore Topics ...

MS Office Forum / Excel / Programming / December 2006

Tip: Looking for answers? Try searching our database.

Poor performance in summing up values on another worksheet

Thread view: 
Enable EMail Alerts  Start New Thread
Thread rating: 
Doug - 11 Dec 2006 01:51 GMT
HI there,

The following code takes 4 seconds per cell to complete the four lines
between Message Box C and D or between D and E. These lines total from the
current worksheet (Calc4) into another worksheet (Summary). I have tried to
tune the code as best possible. If anyone knows of a funtion or a better way
that I can achieve this, it would be greatly appreciated. This will take 8
hours to run as it stands.

DATA DEFINITION
    1 Excel spreadsheet with one worksheet called Calc4 and one called
Summary
    2.Sample Values in Calc 4 cells are (F1-134456/345678  or
F2-454566/456743)

SUBROUTINE

Sub SetManning()
Worksheets("Calc4").Select
For Each c In Worksheets("Calc4").Range("E3:CV400").Cells

v_Value = c.Value

c.Select
   Selection.Interior.ColorIndex = xlNone

If (Left(v_Value, 2) = "F1" Or Left(v_Value, 2) = "F2") Then
   If Len(c.Address) = 4 Then
      vAddress = Left(c.Address, 3)
   Else
      vAddress = Left(c.Address, 4)
   End If
         
  ' Current manning - Set variables to the cell value
     vCurrTradesMen = Right(Left(v_Value, 4), 1)
     vCurrApprenticeY4 = Right(Left(v_Value, 5), 1)
     vCurrApprenticeY3 = Right(Left(v_Value, 6), 1)
     vCurrApprenticeY2 = Right(Left(v_Value, 7), 1)
     vCurrApprenticeY1 = Right(Left(v_Value, 8), 1)
     vCurrProcessWorker = Right(Left(v_Value, 9), 1)
       
   ' Preferred Manning - Set variables to the cell value
     vPrefTradesMen = Right(Left(v_Value, 11), 1)
     vPrefpprenticeY4 = Right(Left(v_Value, 12), 1)
     vPrefApprenticeY3 = Right(Left(v_Value, 13), 1)
     vPrefApprenticeY2 = Right(Left(v_Value, 14), 1)
     vPrefApprenticeY1 = Right(Left(v_Value, 15), 1)
     vPrefprocessWorker = Right(Left(v_Value, 16), 1)
   
  'Fit Out 1 - Yellow
   If Left(v_Value, 2) = "F1" Then
      c.Select
        With Selection.Interior
           .ColorIndex = 36
           .Pattern = xlSolid
           .PatternColorIndex = xlAutomatic
        End With

       vCurrAddr1 = vAddress + "5"
       vCurrAddr2 = vAddress + "6"
       vCurrAddr3 = vAddress + "7"
       vCurrAddr4 = vAddress + "8"
       vCurrAddr5 = vAddress + "9"
       vCurrAddr6 = vAddress + "10"
       vPrefAddr1 = vAddress + "29"
       vPrefAddr2 = vAddress + "30"
       vPrefAddr3 = vAddress + "31"
       vPrefAddr4 = vAddress + "32"
       vPrefAddr5 = vAddress + "33"
       vPrefAddr6 = vAddress + "34"
   Else
      c.Select
      With Selection.Interior
        .ColorIndex = 35
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
      End With
   
      vCurrAddr1 = vAddress + "12"
      vCurrAddr2 = vAddress + "13"
      vCurrAddr3 = vAddress + "14"
      vCurrAddr4 = vAddress + "15"
      vCurrAddr5 = vAddress + "16"
      vCurrAddr6 = vAddress + "17"
      vPrefAddr1 = vAddress + "36"
      vPrefAddr2 = vAddress + "37"
      vPrefAddr3 = vAddress + "38"
      vPrefAddr4 = vAddress + "39"
      vPrefAddr5 = vAddress + "40"
      vPrefAddr6 = vAddress + "41"
   End If
     
MsgBox ("C")
      ' Current manning - Set variables to the cell value
      Worksheets("Summary").Range(vCurrAddr1).FormulaR1C1 =
Worksheets("Summary").Range(vCurrAddr1).Value + vCurrTradesMen
      Worksheets("Summary").Range(vCurrAddr2).FormulaR1C1 =
Worksheets("Summary").Range(vCurrAddr2).Value + vCurrApprenticeY4
      Worksheets("Summary").Range(vCurrAddr3).FormulaR1C1 =
Worksheets("Summary").Range(vCurrAddr3).Value + vCurrApprenticeY3
      Worksheets("Summary").Range(vCurrAddr4).FormulaR1C1 =
Worksheets("Summary").Range(vCurrAddr4).Value + vCurrApprenticeY2
      Worksheets("Summary").Range(vCurrAddr5).FormulaR1C1 =
Worksheets("Summary").Range(vCurrAddr5).Value + vCurrApprenticeY1
      Worksheets("Summary").Range(vCurrAddr6).FormulaR1C1 =
Worksheets("Summary").Range(vCurrAddr6).Value + vCurrProcessWorker
     
MsgBox ("D")
       ' Preferred Manning - Set variables to the cell value
       Worksheets("Summary").Range(vPrefAddr1).FormulaR1C1 =
Worksheets("Summary").Range(vPrefAddr1).Value + vPrefTradesMen
       Worksheets("Summary").Range(vPrefAddr2).FormulaR1C1 =
Worksheets("Summary").Range(vPrefAddr2).Value + vPrefApprenticeY4
       Worksheets("Summary").Range(vPrefAddr3).FormulaR1C1 =
Worksheets("Summary").Range(vPrefAddr3).Value + vPrefApprenticeY3
       Worksheets("Summary").Range(vPrefAddr4).FormulaR1C1 =
Worksheets("Summary").Range(vPrefAddr4).Value + vPrefApprenticeY2
       Worksheets("Summary").Range(vPrefAddr5).FormulaR1C1 =
Worksheets("Summary").Range(vPrefAddr5).Value + vPrefApprenticeY1
       Worksheets("Summary").Range(vPrefAddr6).FormulaR1C1 =
Worksheets("Summary").Range(vPrefAddr6).Value + vPrefprocessWorker
MsgBox ("E")

     
 End If
Next
End Sub
NickHK - 11 Dec 2006 02:49 GMT
Doug,
You haven't decaled any of you variables, so it is hard to know what you
mean by statements like;
vCurrAddr1 = vAddress + "5"

You will find it faster NOT to .select the cells in the range:
c.Interior.ColorIndex = xlNone

You will always find string manipualtion slow, compared to numeric
processing.
So if you must use all those Right, Left, Mid functions because of the way
you data is displayed ("F1-134456/345678"), you may have no choice.
However, using a delimter in the list ("3,4,5,6,7,8") would let you Split
and get all values at the same time.

Whilst impact on perfomanec as such may be neutral, a couple of points may
make you code easier to work with.
Use arrays
Dim vCurrAddr( 1 to 6) As string
Dim vPrefAddr( 1 to 6) As string

Using custom types
Public Type Manning
   TradesMen As Long
   ApprenticeY4 As Long
   ApprenticeY3 As Long
   ApprenticeY2 As Long
   ApprenticeY1 As Long
   ProcessWorker As Long
End Type

Dim Curr As Manning
Dim Pref As Manning

Just a few ideas anyway.

NickHK

> HI there,
>
[quoted text clipped - 122 lines]
>  Next
> End Sub
JMB - 11 Dec 2006 05:52 GMT
One other thing you might try is instead of setting the interior colorindex
to none one cell at a time, do the entire range before the For Each loop

> Worksheets("Calc4").Range("E3:CV400").Interior.ColorIndex = xlNone
> For Each c In Worksheets("Calc4").Range("E3:CV400").Cells
>  
>  v_Value = c.Value
>  

Also, if you have many statements that refer to the same object, use the
With statement

With Worksheets("Summary")
.Range(vCurrAddr1).FormulaR1C1 = _
 .Range(vCurrAddr1).Value + vCurrTradesMen
.Range(vCurrAddr2).FormulaR1C1 = _
 .Range(vCurrAddr2).Value + vCurrApprenticeY4
.Range(vCurrAddr3).FormulaR1C1 = _
 .Range(vCurrAddr3).Value + vCurrApprenticeY3
'.......
'.......
End With

Also, I recall reading that when working w/strings, the Left$, Mid$, and
Right$ functions are a little faster - but I don't have that reference handy
to look up the details.

And you should declare your variables.  It's good practice and I think it
helps performance.  Some of the variables may need to be variants, but surely
not all of them

Sub SetManning()
Dim v_Value As String

Although, depending on what you are doing, it may be necessary to do some
data type conversion using CLng, CStr, CInt, CDbl, etc functions.

> HI there,
>
[quoted text clipped - 123 lines]
>  Next
> End Sub
Charles Williams - 11 Dec 2006 10:14 GMT
Hi Doug,

it would be much faster to work with arrays of values rather than with
formulae one cell at a time.
Get the values into a variant containing an array:

dim vCalc4 as variant
dim vSummary as variant

Application.screenupdating=false
application.calculation=xlcalculationmanual
vCalc4=Worksheets("Calc4").Range("E3:CV400")
vSummary=Worksheets("Summary").range( ?????, ?????) ''' dont know what size
this is

... do your calculations using the arrays

... store the summary array
Worksheets("Summary").range( ?????, ?????) =vSummary

Application.screenupdating=false
application.calculation=xlcalculationmanual

You could use Conditional formatting to control the colours of the cells.

You will need to work out the indexing logic for the summary array as a
replacement for your address calculations.

Using this technique will probably get you to seconds rather than hours, but
if you still need to go faster,
you can speed up your string calculations using Mid$ rather than
Right(left)), or it would be significantly faster to assign the string to a
byte array and index the characters directly.

Charles
______________________
Decision Models
FastExcel 2.3 now available
Name Manager 4.0 now available
www.DecisionModels.com

> HI there,
>
[quoted text clipped - 124 lines]
> Next
> End Sub
 
Sign In
Join
My Latest Posts
My Monitored Threads
My Blog
My Photo Gallery
My Profile
My Homepage

Start New Thread
Enable EMail Alerts
Rate this Thread



©2008 Advenet LLC   Privacy Policy - Terms of Use
This website includes both content owned or controlled by Advenet as well as content owned or controlled by third parties.