Help With Total of Values Please

[Paul Black]

Hi Everybody,

I Have the Following Macro which Produces a List of 7 Totals.
Rather than Using …

ActiveCell.Offset(7, 0).Value = nType(1) + nType(2) + nType(3) +
nType(4) _
+ nType(5) + nType(6) + nType(7)

… to Calculate the Grand Total, is there an Easier VB Solution Rather
than to Use an Excel Formula in the Code Please.

The Macro I am Using is :-

Option Explicit
Option Base 1

Sub Produce_Totals()
Dim A As Integer
Dim B As Integer
Dim C As Integer
Dim D As Integer
Dim E As Integer
Dim F As Integer
Dim I As Integer
Dim nType(7) As Double

Application.ScreenUpdating = False
Sheets("Totals").Select
Range("C4").Select

For I = 1 To 7
nType(I) = 0
Next I

For A = 1 To 25
For B = A + 1 To 26
For C = B + 1 To 27
For D = C + 1 To 28
For E = D + 1 To 29
For F = E + 1 To 30

If F - A >= 10 And F - A <= 12 Then nType(1) = nType(1) + 1
If F - A >= 13 And F - A <= 16 Then nType(2) = nType(2) + 1
If F - A >= 17 And F - A <= 19 Then nType(3) = nType(3) + 1
If F - A >= 20 And F - A <= 21 Then nType(4) = nType(4) + 1
If F - A >= 22 And F - A <= 24 Then nType(5) = nType(5) + 1
If F - A >= 25 And F - A <= 27 Then nType(6) = nType(6) + 1
If F - A >= 28 And F - A <= 30 Then nType(7) = nType(7) + 1

Next F
Next E
Next D
Next C
Next B
Next A

For I = 1 To 7
ActiveCell(I, 1).Value = nType(I)
' ActiveCell.Offset(7, 0).Value = nType(1) + nType(2) + nType(3) +
nType(4) _
+ nType(5) + nType(6) + nType(7)
Next I

Application.ScreenUpdating = True
End Sub

I have Tried Including Another Variable to Total them But without ANY
Success. I think I Might have Been Trying to Put it in the Wrong Place
or Something.
Any Help will be Appreciated.

Thanks in Advance
All the Best
Paul




*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it!

 

[Bob Phillips]

Paul,

Do you mean

For I = 1 To 7
myVal = nType(1) + nType(2) + nType(3) + nType(4) + _
nType(5) + nType(6) + nType(7)
Next I
ActiveCell.Offset(7, 0).Value = myVal


--

HTH

RP
(remove nothere from the email address if mailing direct)

 

[Paul Black]

Thanks for the Reply Bob,

Basically, I want the Grand Total of the 7 Values ( this could Easily be
20 or 30 Values though ) Directly Under the Last Value Produced.
Is there an Easier way to Achieve this Rather than having a Long List of
nType(1) + nType(2) to Possibly + nType(30) Please.

Thanks Again.
All the Best
Paul



*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it!

 

[Bob Phillips]

Paul,

Try this instead then. It assumes that the activecell is in the target
column, row doesn't matter

Dim cLastRow
With ActiveCell
cLastRow = Cells(Rows.Count, .Column).End(xlUp).Row
Cells(cLastRow + 1, .Column).Value = Application.Sum(Cells(1,
..Column).Resize(cLastRow, 1))
End With


--

HTH

RP
(remove nothere from the email address if mailing direct)

 

[Tom Ogilvy]

Just change my original solution

For I = 1 To 7
Cells(I, 1).Value = nType(I)
Next I
Range("A8").Formula = "=Sum(A1:A7)"
End Sub

to

For I = 1 To 7
Cells(I, 1).Value = nType(I)
Next I
Range("A8").Formula = "=Sum(A1:A7)"
Range("A8").Formula = Range("a8").Value
End Sub

or
If you want it to be dynamic for rows (where 7 would be a variable perhaps)
For I = 1 To 7
Cells(I, 1).Value = nType(I)
Next I
Cells(1,1).End(xldown)(2).Value = Application.Sum(Range( _
Cells(1,1),Cells(1,1).End(xldown)))
End Sub

 

[Paul Black]

Thanks Very Much Bob and Tom.

All the Best
Paul



*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it!

 

[Paul Black]

Hi Tom,

You said that I could use ...

For I = 1 To 7
Cells(I, 1).Value = nType(I)
Next I
Cells(1,1).End(xldown)(2).Value = Application.Sum(Range( _
Cells(1,1),Cells(1,1).End(xldown)))
End Sub

... Dynamically Using a Variable.
Does this Mean that I would NOT have to Set the Number of Values to be
Produced Using Dim nType(7) As Double and For I = 1 To 7.
Would it Mean that it would Work Regardless of the Number of Values
Produced and Still Put the Total in the Cell Immediately Under the Last
Value.
Would it be Possible for you Please to Show me Exactly how this would be
Achieved.

Thanks for your Help.
All the Best
Paul

*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it!

 

[Tom Ogilvy]

Is this what you mean:

Option Explicit
Option Base 1

Sub Produce_Totals()
Dim A As Integer
Dim B As Integer
Dim C As Integer
Dim D As Integer
Dim E As Integer
Dim F As Integer
Dim I As Integer
Dim ub as Long
' make nType as dynamic array
Dim nType() As Double

Application.ScreenUpdating = False
Sheets("Totals").Select
Range("C4").Select

' use some algorithm to calculate the upper
' bound of the array. for demo, I just
' set it to 7
ub = 7
Redim nType(1 to ub)

For I = 1 To ub
nType(I) = 0
Next I

'
' an algorithm that populates nType()
'


For I = 1 To ub
ActiveCell(I, 1).Value = nType(I)
Next I

Cells(1,1).End(xldown)(2).Value = Application.Sum(Range( _
Cells(1,1),Cells(1,1).End(xldown)))


Application.ScreenUpdating = True
End Sub


If you can't tell the upperbound of the array until after your main
algorithm runs, then you can initially dimension it to the highest number
possible, then resize it after if necessary

ub = 100
Redim ntype(1 to ub)

' main algorithm including setting ub to some other number

Redim Preserve ntype(1 to ub)

for i = 1 to ub
cells(i,1).value = ntype(1 to ub)
Next

 

[Paul Black]

Hi Tom,

Thanks for the Help.
I Ran your First Example and it Produced the Correct Results for the
Totals, But gave me a Runtime Error '1004'. I think this was Because it
could NOT Produce the Grand Total.

Cells(1, 1).End(xlDown)(2).Value = Application.Sum(Range( _
Cells(1, 1), Cells(1, 1).End(xlDown)))

I will NOT Know the UpperBound of the Results in Most Cases, so I will
Find out how the UpperBound and ReSize Works and then try and Implement
that into your Second Example.

Thanks Again for your Help.
All the Best
Paul




*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it!