Add the digits of the sum totals for EVEN & ODD numbers together and produce the total combinations.

S.H.A.D.O.

S.H.A.D.O.

Well-known Member
Joined
Sep 6, 2005
Messages
1,915
Good afternoon,

I have the following code which cycles through combinations and sums the totals for all the Odd & Even numbers within each combination. This runs and outputs the data into the WorkSheet. This work great.

Code: 
Option Explicit
Option Base 1
    Const Drawn As Long = 6
    Const MaxF As Long = 19

    Dim nEven() As Long
    Dim nOdd() As Long
    Dim m_recLvl As Long

Sub Odd_And_Even()
    Dim vEven As Variant, vOdd As Variant
    Dim i As Long
    Dim CountEven As Long, CountOdd As Long
    Dim lRow As Long
    Dim MyDist As Variant

    With Application
        .ScreenUpdating = False: .Calculation = xlCalculationManual: .DisplayAlerts = False
    End With
    Columns("A:F").ClearContents
    Cells(1, 1).Select
        
    ReDim nEven(0 To Drawn * MaxF)
    ReDim nOdd(0 To Drawn * MaxF)
    
    doRecurse 1, 0, 0
    With ActiveCell
        ReDim vEven(1 To UBound(nEven), 1 To 2)
        ReDim vOdd(1 To UBound(nOdd), 1 To 2)
        
        For i = 0 To UBound(nEven)
            If nEven(i) > 0 Then
                CountEven = CountEven + 1
                vEven(CountEven, 1) = i
                vEven(CountEven, 2) = nEven(i)
            End If
            If nOdd(i) > 0 Then
                CountOdd = CountOdd + 1
                vOdd(CountOdd, 1) = i
                vOdd(CountOdd, 2) = nOdd(i)
            End If
        Next i
        
        lRow = ActiveCell.Row
        MyDist = Array("Even Sum", "Total Combinations", "Odd Sum", "Total Combinations")
        ActiveCell.Offset(0, 0).Resize(UBound(MyDist), 4) = MyDist
        ActiveCell.Offset(1, 0).Resize(CountEven, 2) = vEven
        ActiveCell.Offset(1, 2).Resize(CountOdd, 2) = vOdd
   
        ActiveCell.Offset(CountEven + 1, 1).FormulaR1C1 = "=Sum(R" & lRow + 1 & "C:R[-1]C)"
        ActiveCell.Offset(CountOdd + 1, 3).FormulaR1C1 = "=Sum(R" & lRow + 1 & "C:R[-1]C)"
    End With
    With Application
        .DisplayAlerts = True: .Calculation = xlCalculationAutomatic: .ScreenUpdating = True
    End With
End Sub

Function doRecurse(stInd As Long, EvenSum As Long, OddSum As Long)
    Dim i As Long
    Dim EvenAdd As Long, OddAdd As Long

    m_recLvl = m_recLvl + 1

    For i = stInd To MaxF - Drawn + m_recLvl
        If m_recLvl < Drawn Then
            If i Mod 2 = 0 Then
                doRecurse i + 1, EvenSum + i, OddSum
            Else
                doRecurse i + 1, EvenSum, OddSum + i
            End If
        Else
            If i Mod 2 = 0 Then
                EvenAdd = i: OddAdd = 0
            Else
                OddAdd = i: EvenAdd = 0
            End If
            nEven(EvenSum + EvenAdd) = nEven(EvenSum + EvenAdd) + 1
            nOdd(OddSum + OddAdd) = nOdd(OddSum + OddAdd) + 1
        End If
    Next i

    m_recLvl = m_recLvl - 1
End Function

What I am trying to do now is to work out the Root, and the assocciated sum totals.
By that I mean, if the Even sum was 68, then the 68 would become 14, i.e. 6+8=14, and the assocciated sum total. This will be the same for all the others.

Something along the lines if we used a formula of...

Code: 
=SUMPRODUCT(INT(n/10)+MOD(n,10))

...where n is the sum total to be converted to the Root total.

I hope I have explained this clearly enough.

Adapting the above code should produce the following results.

Code: 
[TABLE="width: 312"]
<TBODY>[TR]
[TD]Even Root</SPAN>
[/TD]
[TD]Total</SPAN>
[/TD]
[TD]Odd Root</SPAN>
[/TD]
[TD]Total</SPAN>
[/TD]
[/TR]
[TR]
[TD="align: right"]0</SPAN>
[/TD]
[TD="align: right"]210</SPAN>
[/TD]
[TD="align: right"]0</SPAN>
[/TD]
[TD="align: right"]84</SPAN>
[/TD]
[/TR]
[TR]
[TD="align: right"]1</SPAN>
[/TD]
[TD="align: right"]672</SPAN>
[/TD]
[TD="align: right"]1</SPAN>
[/TD]
[TD="align: right"]378</SPAN>
[/TD]
[/TR]
[TR]
[TD="align: right"]2</SPAN>
[/TD]
[TD="align: right"]1617</SPAN>
[/TD]
[TD="align: right"]2</SPAN>
[/TD]
[TD="align: right"]912</SPAN>
[/TD]
[/TR]
[TR]
[TD="align: right"]3</SPAN>
[/TD]
[TD="align: right"]2452</SPAN>
[/TD]
[TD="align: right"]3</SPAN>
[/TD]
[TD="align: right"]1704</SPAN>
[/TD]
[/TR]
[TR]
[TD="align: right"]4</SPAN>
[/TD]
[TD="align: right"]2817</SPAN>
[/TD]
[TD="align: right"]4</SPAN>
[/TD]
[TD="align: right"]2549</SPAN>
[/TD]
[/TR]
[TR]
[TD="align: right"]5</SPAN>
[/TD]
[TD="align: right"]2936</SPAN>
[/TD]
[TD="align: right"]5</SPAN>
[/TD]
[TD="align: right"]2812</SPAN>
[/TD]
[/TR]
[TR]
[TD="align: right"]6</SPAN>
[/TD]
[TD="align: right"]3071</SPAN>
[/TD]
[TD="align: right"]6</SPAN>
[/TD]
[TD="align: right"]3006</SPAN>
[/TD]
[/TR]
[TR]
[TD="align: right"]7</SPAN>
[/TD]
[TD="align: right"]2951</SPAN>
[/TD]
[TD="align: right"]7</SPAN>
[/TD]
[TD="align: right"]2987</SPAN>
[/TD]
[/TR]
[TR]
[TD="align: right"]8</SPAN>
[/TD]
[TD="align: right"]2951</SPAN>
[/TD]
[TD="align: right"]8</SPAN>
[/TD]
[TD="align: right"]2951</SPAN>
[/TD]
[/TR]
[TR]
[TD="align: right"]9</SPAN>
[/TD]
[TD="align: right"]3072</SPAN>
[/TD]
[TD="align: right"]9</SPAN>
[/TD]
[TD="align: right"]3036</SPAN>
[/TD]
[/TR]
[TR]
[TD="align: right"]10</SPAN>
[/TD]
[TD="align: right"]2279</SPAN>
[/TD]
[TD="align: right"]10</SPAN>
[/TD]
[TD="align: right"]2735</SPAN>
[/TD]
[/TR]
[TR]
[TD="align: right"]11</SPAN>
[/TD]
[TD="align: right"]1334</SPAN>
[/TD]
[TD="align: right"]11</SPAN>
[/TD]
[TD="align: right"]2039</SPAN>
[/TD]
[/TR]
[TR]
[TD="align: right"]12</SPAN>
[/TD]
[TD="align: right"]620</SPAN>
[/TD]
[TD="align: right"]12</SPAN>
[/TD]
[TD="align: right"]1332</SPAN>
[/TD]
[/TR]
[TR]
[TD="align: right"]13</SPAN>
[/TD]
[TD="align: right"]134</SPAN>
[/TD]
[TD="align: right"]13</SPAN>
[/TD]
[TD="align: right"]438</SPAN>
[/TD]
[/TR]
[TR]
[TD="align: right"]14</SPAN>
[/TD]
[TD="align: right"]15</SPAN>
[/TD]
[TD="align: right"]14</SPAN>
[/TD]
[TD="align: right"]139</SPAN>
[/TD]
[/TR]
[TR]
[TD="align: right"]15</SPAN>
[/TD]
[TD="align: right"]1</SPAN>
[/TD]
[TD="align: right"]15</SPAN>
[/TD]
[TD="align: right"]30</SPAN>
[/TD]
[/TR]
[TR]
[TD][/TD]
[TD="align: right"][B]27132[/B]</SPAN>
[/TD]
[TD][/TD]
[TD="align: right"][B]27132</SPAN>[/B]
[/TD]
[/TR]
</TBODY>[/TABLE]

Thanks in advance.
 

Excel Facts

Select all contiguous cells
Pressing Ctrl+* (asterisk) will select the "current region" - all contiguous cells in all directions.
Sort by date Sort by votes
this function provides the sum of all characters in a number
Code: 
Function root(num As Long) As Integer
Dim strNum As String: strNum = CStr(num)
Dim i As Integer
For i = 1 To Len(strNum)
    root = root + CInt(Mid(strNum, i, 1))
Next i
End Function
 
Upvote 0
Thanks for the reply baitmaster, very nice Function.
I do actually want to adapt the code that I posted to achieve this though please.
 
Upvote 0
baitmaster said:
this function provides the sum of all characters in a number
Code: 
Function root(num As Long) As Integer
Dim strNum As String: strNum = CStr(num)
Dim i As Integer
For i = 1 To Len(strNum)
    root = root + CInt(Mid(strNum, i, 1))
Next i
End Function
Click to expand...
I thought you might be interested in seeing a non-looping one-liner version of your function...
Code: 
Function Root(Num As Long) As Long
  Root = Evaluate(Replace(StrConv(Num, vbUnicode), Chr(0), "+") & 0)
End Function
 
Upvote 0
Very nice indeed Rick, as always.

Would it be the variable i that I need to manipulate to get the digits added together?
I would then assume that the sum totals would take care of themselves.

Thanks in advance.
 
Upvote 0
S.H.A.D.O. said:
Would it be the variable i that I need to manipulate to get the digits added together?
I would then assume that the sum totals would take care of themselves.
Click to expand...
Given that i is your iteration variable, probably not, but to tell you the truth I don't know for sure because I am having trouble reading your code and figuring out what outputs are needed. I look at your output table and really have no idea where any of the numbers are coming from. Sorry, but I am just having trouble locking onto what is going on (I have no idea where any of the totals in the "result" table in Message #1 come from).
 
Upvote 0
@baitmaster
@Rick

What should be added to your code in such a way that the result will be 6 in the example below.
Ex. A1 = 12345, B1 = root (A1) = 15 but I would want the function result to be six (ie 1 + 5)
12345 --> 15 --> 6
A1=12345, B1=root(A1)=6

Thanks
 
Last edited:
Upvote 0
Ingolf said:
@baitmaster
@Rick

What should be added to your code in such a way that the result will be 6 in the example below.
Ex. A1 = 12345, B1 = root (A1) = 15 but I would want the function result to be six (ie 1 + 5)
12345 --> 15 --> 6
A1=12345, B1=root(A1)=6
Click to expand...
The code would be different for that (I'll still call it Root for lack of a better name)...
Code: 
Function Root(Num As Long) As Long
  Root = 1 + ((Num - 1) Mod 9)
End Function
 
Last edited:
Upvote 0
Hi Rick,

I will try and explain this a bit better.

If you were to run the code as in post #1 it will give you 4 columns of data:

Column A, Even Sum
Column B, Total Combinations
Column C, Odd Sum
Column D, Total Combinations

The Even Sum (column A) is made up from looping through all the combinations individually and adding only those numbers that are Even together within each combination.
For example, the combination 02, 21, 28, 39, 48, 56 would become Even Sum 02 + 28 + 48 + 56 = 134.
Then in column B, the Total Combinations is the total of all those individual combinations where the Even Sum total adds up to 134.

The same logic applies to the Odd Sum.

Now, the code I posted does exactly that and works correctly, although I appreciate that there is probably a far easier and simpler way of doing this other than the code I have got, it wouldn't surprise me at all.

Now to my request.

As I have just stated above, there are 4 columns of data produced:

Column A, Even Sum
Column B, Total Combinations
Column C, Odd Sum
Column D, Total Combinations

What I want to do is to amend the code in post #1 so that it adds the Even Sum digits together in column A to give a new Even Sum (Root) total, so for the example I gave, the combination 02, 21, 28, 39, 48, 56 would become sum 02 + 28 + 48 + 56 = 134, so the new Even Sum (Root) total would be 1 + 3 + 4 = 8.
Then in column B, the Total Combinations is the total of all those individual combinations where the Even Sum (Root) total adds up to 8.

The same logic applies to the Odd Sum.

Then the ouput would be as below:

[TABLE="width: 234"]
<TBODY>[TR]
[TD="class: xl66, width: 74, bgcolor: transparent"]Even Root
[/TD]
[TD="class: xl66, width: 81, bgcolor: transparent"]Total
[/TD]
[TD="class: xl66, width: 74, bgcolor: transparent"]Odd Root
[/TD]
[TD="class: xl66, width: 81, bgcolor: transparent"]Total
[/TD]
[/TR]
[TR]
[TD="class: xl65, bgcolor: transparent, align: right"]0
[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]210
[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]0
[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]84
[/TD]
[/TR]
[TR]
[TD="class: xl65, bgcolor: transparent, align: right"]1
[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]672
[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]1
[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]378
[/TD]
[/TR]
[TR]
[TD="class: xl65, bgcolor: transparent, align: right"]2
[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]1617
[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]2
[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]912
[/TD]
[/TR]
[TR]
[TD="class: xl65, bgcolor: transparent, align: right"]3
[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]2452
[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]3
[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]1704
[/TD]
[/TR]
[TR]
[TD="class: xl65, bgcolor: transparent, align: right"]4
[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]2817
[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]4
[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]2549
[/TD]
[/TR]
[TR]
[TD="class: xl65, bgcolor: transparent, align: right"]5
[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]2936
[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]5
[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]2812
[/TD]
[/TR]
[TR]
[TD="class: xl65, bgcolor: transparent, align: right"]6
[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]3071
[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]6
[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]3006
[/TD]
[/TR]
[TR]
[TD="class: xl65, bgcolor: transparent, align: right"]7
[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]2951
[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]7
[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]2987
[/TD]
[/TR]
[TR]
[TD="class: xl65, bgcolor: transparent, align: right"]8
[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]2951
[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]8
[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]2951
[/TD]
[/TR]
[TR]
[TD="class: xl65, bgcolor: transparent, align: right"]9
[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]3072
[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]9
[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]3036
[/TD]
[/TR]
[TR]
[TD="class: xl65, bgcolor: transparent, align: right"]10
[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]2279
[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]10
[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]2735
[/TD]
[/TR]
[TR]
[TD="class: xl65, bgcolor: transparent, align: right"]11
[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]1334
[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]11
[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]2039
[/TD]
[/TR]
[TR]
[TD="class: xl65, bgcolor: transparent, align: right"]12
[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]620
[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]12
[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]1332
[/TD]
[/TR]
[TR]
[TD="class: xl65, bgcolor: transparent, align: right"]13
[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]134
[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]13
[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]438
[/TD]
[/TR]
[TR]
[TD="class: xl65, bgcolor: transparent, align: right"]14
[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]15
[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]14
[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]139
[/TD]
[/TR]
[TR]
[TD="class: xl65, bgcolor: transparent, align: right"]15
[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]1
[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]15
[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]30
[/TD]
[/TR]
[TR]
[TD="class: xl65, bgcolor: transparent"][/TD]
[TD="class: xl67, bgcolor: transparent, align: right"]27132
[/TD]
[TD="class: xl65, bgcolor: transparent"][/TD]
[TD="class: xl67, bgcolor: transparent, align: right"]27132
[/TD]
[/TR]
</TBODY>[/TABLE]

Thanks in advance.
 
Upvote 0
You must log in or register to reply here.

Similar threads

L
  • Question Question
Help to add a sum total to a Ron de Bruin VBA
Replies
1
Views
1K
atongsun
A
A
  • Question Question
Combine Duplicate Data Into One Row and Add Column Data
Replies
1
Views
693
AcornNut
A
S.H.A.D.O.
  • Question Question
Loop through combinations and add only Even & Odd numbers together within each combination.
Replies
4
Views
697
S.H.A.D.O.
S.H.A.D.O.
S.H.A.D.O.
  • Question Question
Add digits together
2
Replies
11
Views
906
S.H.A.D.O.
S.H.A.D.O.
S.H.A.D.O.
  • Question Question
Loop through and SUM total the ODD & EVEN Numbers.
2
Replies
19
Views
2K
S.H.A.D.O.
S.H.A.D.O.

Forum statistics

Threads
1,223,243
Messages
6,170,967
Members
452,371
Latest member
Frana

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top