How can I list all the combinations that meet certain criteria using Excel VBA?

Question

Which are the combinations that the sum of each digit is equal to 8 or less, from 1 to 88,888,888?

For example,
70000001 = 7+0+0+0+0+0+0+1 = 8 Should be on the list
00000021 = 0+0+0+0+0+0+2+1 = 3 Should be on the list.
20005002 = 2+0+0+0+5+0+0+2 = 9 Should not be on the list.

Sub Comb()
Dim r As Integer 'Row (to store the number)
Dim i As Integer 'Range
r = 1
For i = 0 To 88888888
If i = 8
'How can I get the sum of the digits on vba?
ActiveSheet.Cells(r, 1) = i
r = r + 1
End If
Else
End Sub

Looks like a homework question... http://www.whathaveyoutried.com — Paul Grimshaw, Feb 11 '13 at 15:27
(i) loop from 1 to 88,888,888 (ii) for each of those numbers calculate the sum of the figures (iii) if it adds up to 8, store it somewhere or print it (iv) give yourself a pat on the back... — assylias, Feb 11 '13 at 15:28
Hi, welcome to SO! What did you try so far, where are you stuck? — Peter Albert, Feb 11 '13 at 15:29
I know elegant solution using formulas only, but I'd like to see at least some efforts first) — Peter L., Feb 11 '13 at 15:32
This is the idea I have, but I'm stuck on calculating the number of digits: — user2061788, Feb 11 '13 at 15:45
@PeterL. ... That's bragging. You don't have to give me an answer, but that is impossible. Even using this formula =SUM(VALUE(MID(B2,ROW($A$1:OFFSET($A$1,LEN(B2)-1,0)),1))) all the alternatives can't be generated with formulas only. — user2061788, Feb 11 '13 at 17:22
@user2061788 why not? all you need is to loop all numbers from 1 to 88,888,888 - also with the help of formulas))) that's even more trivial! However, I'm not sure whether Excel could happily handle 200M+ formulas in a single book, but that's another question) — Peter L., Feb 11 '13 at 17:28
@PeterL. I'm able to identify the numbers that meet the criteria in 1,000,000, that's why I asked here to get help and not have to do the proccess 88 times. — user2061788, Feb 11 '13 at 17:30
@user2061788 put this formula in `EVALUATE` vba wrapper - and you're done. — Peter L., Feb 11 '13 at 17:38
@PaulGrimshaw it was not for a homework. And now I solved it. Sub Comb() Dim i As Long Dim r As Long Range("B3").Select r = 3 For i = 0 To 88888888 If ActiveCell.offset(-1, -1).Range("A1").Value < 8 Then ActiveSheet.Cells(r, 2) = i r = r + 1 Else End If Next i End Sub — user2061788, Feb 11 '13 at 17:49

score 1 · Answer 1 · answered Feb 11 '13 at 17:49

... Is this what you're looking for?

Function AddDigits(sNum As String) As Integer

Dim i As Integer

   AddDigits = 0
   For i = 1 To Len(sNum)
      AddDigits = AddDigits + CInt(Mid(sNum, i, 1))
   Next i

End Function

(Just remember to use CStr() on the number you pass into the function.

If not, can you explain what it is you want in a bit more detail.

Hope this helps

score 0 · Answer 2 · answered Feb 11 '13 at 20:27

The method you suggest is pretty much brute force. On my machine, it ran 6.5min to calculate all numbers. so far a challenge I tried to find a more efficient algorithm.

This one takes about 0.5s:

Private Const cIntNumberOfDigits As Integer = 9
Private mStrNum As String
Private mRng As Range

Private Sub GetNumbers()
    Dim dblStart As Double
    Set mRng = Range("a1")
    dblStart = Timer
    mStrNum = Replace(Space(cIntNumberOfDigits), " ", "0")
    subGetNumbers 8
    Debug.Print (Timer - dblStart) / 10000000, (Timer - dblStart)
End Sub


Private Sub subGetNumbers(intMaxSum As Integer, Optional intStartPos As Integer = 1)
    Dim i As Integer

    If intStartPos = cIntNumberOfDigits Then
        Mid(mStrNum, intStartPos, 1) = intMaxSum
        mRng.Value = Val(mStrNum)
        Set mRng = mRng.Offset(1)
        Mid(mStrNum, intStartPos, 1) = 0
        Exit Sub
    End If

    For i = 0 To intMaxSum
        Mid(mStrNum, intStartPos, 1) = CStr(i)
        subGetNumbers intMaxSum - i, intStartPos + 1
    Next i
    Mid(mStrNum, intStartPos, 1) = 0
End Sub

It can be sped up further by about factor 10 by using arrays instead of writing directly to the range and offsetting it, but that should suffice for now! :-)

score 0 · Answer 3 · answered Apr 29 '15 at 00:11

As an alternative, You can use a function like this:

Function isInnerLowr8(x As Long) As Boolean
    Dim strX As String, inSum As Long

    isInnerLowr8 = False
    strX = Replace(CStr(x), "0", "")
    For i = 1 To Len(strX)
        Sum = Sum + Val(Mid(strX, i, 1))
        If Sum > 8 Then Exit Function
    Next i
    isInnerLowr8 = True
End Function

Now change If i = 8 to If isInnerLowr8(i) Then.

How can I list all the combinations that meet certain criteria using Excel VBA?

3 Answers3