Sum Combination Algorithm - Friday Afternoon Puzzle!!
Hi,
Any expert out there ....
I am looking for an algorithm for a VBA-Excel-program.
I have 8 different numbers in an excel spreadsheet row in cells a1,b1,c1,d1,e1,f1,g1,h1 - the number being 10,2,5,6,7,4,1,12
The algorithm should now give all combinations for all the sums i.e. the sum of all 8 numbers, the sum of 7 number in all combinations, sum of 6 numbers in all combinations ..... sum of 2 numbers in all combinations etc
There should be a total of 255 sum combinations, the sum combination being as follows:
Combinations
Sum 8 from 8 1
Sum 7 from 8 8
Sum 6 from 8 28
Sum 5 from 8 56
Sum 4 from 8 70
Sum 3 from 8 56
Sum 2 from 8 28
Sum 1 from 8 8
Total Combinations 255
This was actually an interesting challenge (yes, I have no life!). What I came up with uses the fact that the numbers 0 to 255, converted to binary, include eight bits containing every combination of 1's and 0's possible. Using this fact, I simply go through each number, determine which bits are 1, add the corresponding value to the sum (labeled, interestingly enough "Sum"), increase the bit counter (labeled "Bits", not much originality here), and continue for each of the eight bits. I then place the value in the corresponding column (using "Bits" to determine how many values were included). I started the numbers on Row 5, giving you rows 2-4 to include headers, etc.
Well, here it is, tell me what you think:
Sub Sums()
Dim NextRow As Variant, X As Integer, Y As Integer, Sum As Integer, Bits As Integer
NextRow = Array(5, 5, 5, 5, 5, 5, 5, 5)
For X = 1 To 255
Sum = 0
Bits = 0
For Y = 0 To 7
If X And 2 ^ Y Then
Sum = Sum + Me.Cells(1, Y + 1)
Bits = Bits + 1
End If
Next Y
Me.Cells(NextRow(Bits - 1), Bits).Value = Sum
NextRow(Bits - 1) = NextRow(Bits - 1) + 1
Next X
End Sub
0
richardbarry23Author Commented:
Thanks.
I just tried to run the vba and the following error came up:
"Compile Error - Invalid use Me keyword" for the following line "Sum = Sum + Me.Cells(1, Y + 1)"
My Vba coding skills is not that strong so i am not sure what this error means.
Try Worksheets("SheetName") in place of "Me". Make sure to us it both places, as follows (replace "SheetName" with the name of the worksheet the data is on, in quotes):
Sub Sums()
Dim NextRow As Variant, X As Integer, Y As Integer, Sum As Integer, Bits As Integer
NextRow = Array(5, 5, 5, 5, 5, 5, 5, 5)
For X = 1 To 255
Sum = 0
Bits = 0
For Y = 0 To 7
If X And 2 ^ Y Then
Sum = Sum + Worksheets("SheetName").Cells(1, Y + 1)
Bits = Bits + 1
End If
Next Y
Worksheets("SheetName").Cells(NextRow(Bits - 1), Bits).Value = Sum
NextRow(Bits - 1) = NextRow(Bits - 1) + 1
Next X
End Sub
0
Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.
Thanks - i made the changes and ran the macro. The following results came out on the SheetName worksheet:
Starting on the corresponding cells A5,B5,C5,D5,E5,F5,G5,H5 - there were 8,28,56,70,56,28,1 zeros listed in each respective column (i.e. being A5:A12; B5:B32; C5:C60;D5:D74;E5:E60; F5:F32; G5:G12; H5:H5).
Assuming i place the data to be summed in A4,B4,C4,D4,E4,F4,G4,H4 (for instance, being 10,2,5,6,7,4,1,12), instead of the zeros showing up, can the actual individual sums showing up in A5:A12; B5:B32; C5:C60;D5:D74;E5:E60; F5:F32; G5:G12; H5:H5 ?
Thanks in advance for you patience with my minimal vba coding skills!
Try this. At the top of your codesheet, before any routines, place the line "Option Explicit". Then select "Complie..." under the debug menu. It seems you have 'added' a variable somewhere (probably through a mspelling), which would account for the zeros.
If that isn't it, then cut and paste the code exactly as you have it. I'm guessing either the "Sum=..." line is wrong, or the data has not been placed in the first row of the spreadsheet.
As far as the rest of your question, you can place the data on any row you wish (up to row four, after that it would get overwritten by the routine). All you'd have to do then would be to change the "Sum=..." line accordingly. This will not work to correct your problem, however.
0
richardbarry23Author Commented:
Perfect - thanks. I didn't have the data in the first row!!
I assume we're done here :) I can ride off into the sunset (er...sunrise) now?
0
richardbarry23Author Commented:
Yes - the sun is rising or setting somewhere around the world - thanks for your help
0
richardbarry23Author Commented:
Sorry - one final question, I been trying to get the sum data to two decimal places - how do i do that - i should make this 25 more bonus points but i am not sure how to add the bonus points in
Tell me if this answers your question. Also, did you understand the code in the accepted answer above? If not, tell me which part is greek to you, and I'll explain.
0
richardbarry23Author Commented:
Thanks - it tried your coding in point 3 and also made variable
Sum to be defined as a Double (not
Integer). All working now. But a quick question on the rounding accuracy - does the summing occur first at the number of decimal place for the inputs and then the results get rounded OR is each individual input in the sum first rounded then summed (i.e. looking at the degree of accuracy in the rounding assumptions)
Depends on when you round it. Since the sum isn't written into the spreadsheet until it is completely calculated, the answer is fully accurate for all decimal places. And formatting the cells does not change the number in the cell at all, just the way it is displayed. To see what I'm talking about, just format a cell in a spreadsheet to "Number" with two decimal places, then type a number with three decimal places or more into the cell (i.e. "3.256"). You will then see the number rounded to two places in the cell ("3.26") but if you move the cursor to the cell itself, you'll note the original number ("3.256") is actually what's stored in the cell. Thus, full accuracy is maintained regardless of how you choose to display the result.
If you wanted to round the numbers to two decimal places first, then add them together, simply change the "Sum = ..." line as follows:
Sum = Sum + Fix(Worksheets("SheetName").Cells(1, Y + 1)*100+.5)/100
"Fix" removes the decimal portion, multiplying y 100 then dividing by 100 ensures the first two decimal places remain, and adding the .5 to the equation ensure rounding is done properly.
0
richardbarry23Author Commented:
Understand - thanks for your help, it has been very much appreciated.
0
richardbarry23Author Commented:
Sorry for the futher questions. I have spent hours trying to figure out the order of the combination in which the alogorithm produces the sum. Since my Vba skill are not that great, i don't really know what your binary code means.
Is it possible when your alogorithm produce the results, to also record the columns in the base data it has summed and in what order.
For instance, the 8 data points are a1,b1,c1,d1,e1,f1,g1,h1
Sum 8 from 8 = sum(a1,b1,c1,d1,e1,f1,g1,h1)
Sum 7 from 8 = sum(a1,b1,c1,d1,e1,f1,g1); sum(b1,c1,d1,e1,f1,g1,h1) etc for all 8 combinations
Sum 6 form 8 = etc for all 28 combinations
The objective is once the result are produced, to be able to deterine which number were actaual summed in an sum produced by the algorithm (i.e. is it able to leave what columns were summed or better still to formula in the cell like a1+b1+..etc
I don't want to keep asking you questions unrewarded, but if i post another question i am not sure you will see it!!
0
richardbarry23Author Commented:
dkalel,
I have figured it out - so not to worry about last question. Thanks
Well, here it is, tell me what you think:
Sub Sums()
Dim NextRow As Variant, X As Integer, Y As Integer, Sum As Integer, Bits As Integer
NextRow = Array(5, 5, 5, 5, 5, 5, 5, 5)
For X = 1 To 255
Sum = 0
Bits = 0
For Y = 0 To 7
If X And 2 ^ Y Then
Sum = Sum + Me.Cells(1, Y + 1)
Bits = Bits + 1
End If
Next Y
Me.Cells(NextRow(Bits - 1), Bits).Value = Sum
NextRow(Bits - 1) = NextRow(Bits - 1) + 1
Next X
End Sub