excel - Get all combinations of summing numbers

Question

Column A in sheet1 has the values [1,2,3,4,5,6] in range("A1:A6") and what I am trying to do is to get all the combinations of summing each two numbers and each three numbers and each four numbers and each five numbers This is what I did till now but the results are not as I expected

Sub Test()
    Dim a, b, lr As Long, i As Long, j As Long, k As Long, ii As Long
    lr = Cells(Rows.Count, 1).End(xlUp).Row
    For i = 1 To lr
        For j = i To lr
            For ii = j To lr
                Cells(i, ii + 1) = i & "+" & j & "+" & ii & "=" & i + j + ii
            Next ii
        Next j
    Next i
    With Range("A1").CurrentRegion
        a = .Offset(, 1).Resize(, .Columns.Count - 1).Value
        ReDim b(1 To UBound(a, 1) * UBound(a, 2), 1 To 1)
        For i = LBound(a) To UBound(a)
            For j = LBound(a, 2) To UBound(a, 2)
                If a(i, j) <> "" Then
                    k = k + 1
                    b(k, 1) = a(i, j)
                End If
            Next j
        Next i
        .Cells(1, .Columns.Count + 2).Resize(k).Value = b
    End With
End Sub

Example of the desired output: Each two numbers together >>

Sub Test()
    Dim a, b, lr As Long, i As Long, j As Long, k As Long, ii As Long
    lr = Cells(Rows.Count, 1).End(xlUp).Row
    For i = 1 To lr
        For j = i To lr
            Cells(i, j + 1) = i & "+" & j & "=" & i + j
        Next j
    Next i
    With Range("A1").CurrentRegion
        a = .Offset(, 1).Resize(, .Columns.Count - 1).Value
        ReDim b(1 To UBound(a, 1) * UBound(a, 2), 1 To 1)
        For i = LBound(a) To UBound(a)
            For j = LBound(a, 2) To UBound(a, 2)
                If a(i, j) <> "" Then
                    k = k + 1
                    b(k, 1) = a(i, j)
                End If
            Next j
        Next i
        .Cells(1, .Columns.Count + 2).Resize(k).Value = b
    End With
End Sub

The results would be like that in column J

1+1=2
1+2=3
1+3=4
1+4=5
1+5=6
1+6=7
2+2=4
2+3=5
2+4=6
2+5=7
2+6=8
3+3=6
3+4=7
3+5=8
3+6=9
4+4=8
4+5=9
4+6=10
5+5=10
5+6=11
6+6=12

This is OK for each two numbers .. How can I get the results for each three numbers and for each four numbers and for each five numbers?

** @Vityata

Public Sub PrintArrayOnSingleLine(myArray As Variant)

    Dim i As Long, x As Long
    Dim textArray As String, temp As String
    
    For i = LBound(myArray) To UBound(myArray)
        textArray = textArray & myArray(i)
        x = x + Val(myArray(i))
        temp = temp & "+" & myArray(i)
    Next i
    
    Dim myLastRow As Long
    myLastRow = LastRow(Worksheets(1).Name) + 1
    ActiveSheet.Cells(myLastRow, 1) = Mid(temp, 2) & "=" & x
    
End Sub

I have edited the procedure as you told me, but just one note, I can't get the same number to be summed. Example: 1+1=2

question from:https://stackoverflow.com/questions/65916793/get-all-combinations-of-summing-numbers

Answer 1

• Combination (not repeating same values):

Copy the code below and run it. Then change the variable in size = n. The given numbers are in the initialArray. In the end, instead of printing the array as a textArray, add a variable to sum it:

Sub Main()
    
    Dim size As Long: size = 2
    Dim initialArray As Variant: initialArray = Array(1, 2, 3, 4, 5, 6)
    Dim arr As Variant: ReDim arr(size - 1)
    Dim n As Long: n = UBound(arr) + 1
    
    EmbeddedLoops 0, size, initialArray, n, arr
    
End Sub

Function EmbeddedLoops(index As Long, size As Long, initialArray As Variant, n As Long, arr As Variant)
    
    Dim p As Variant
    
    If index >= size Then
        If Not AnyValueBiggerThanNext(arr) And Not AnyValueIsRepeated(arr) Then
            PrintArrayOnSingleLine arr
        End If
    Else
        For Each p In initialArray
            arr(index) = p
            EmbeddedLoops index + 1, size, initialArray, n, arr
        Next p
    End If
    
End Function

Public Function AnyValueBiggerThanNext(arr As Variant) As Boolean

    Dim i As Long
    For i = LBound(arr) To UBound(arr) - 1
        If arr(i) > arr(i + 1) Then
            AnyValueBiggerThanNext = True
            Exit Function
        End If
    Next i
    
    AnyValueBiggerThanNext = False

End Function

Public Function AnyValueIsRepeated(arr As Variant) As Boolean
            
    On Error GoTo AnyValueIsRepeated_Error:
    
    Dim element As Variant
    Dim testCollection As New Collection
    
    For Each element In arr
        testCollection.Add "item", CStr(element)
    Next element
    
    AnyValueIsRepeated = False
    
    On Error GoTo 0
    Exit Function
    
AnyValueIsRepeated_Error:
    AnyValueIsRepeated = True
    
End Function

Public Sub PrintArrayOnSingleLine(myArray As Variant)

    Dim i As Long
    Dim textArray As String
    
    For i = LBound(myArray) To UBound(myArray)
        textArray = textArray & myArray(i)
    Next i
    
    Debug.Print textArray
    
End Sub

---

• Permutation (repeating same values)

---

Sub Main()
    
    Static size         As Long
    Static c            As Variant
    Static arr          As Variant
    Static n            As Long
    
    size = 3
    c = Array(1, 2, 3, 4, 5, 6)
    
    n = UBound(c) + 1
    ReDim arr(size - 1)
    
    EmbeddedLoops 0, size, c, n, arr
    
End Sub

Function EmbeddedLoops(index, k, c, n, arr)
    
    Dim i                   As Variant
    
    If index >= k Then
        PrintArrayOnSingleLine arr
    Else
        For Each i In c
            arr(index) = i
            EmbeddedLoops index + 1, k, c, n, arr
        Next i
    End If

End Function

Public Sub PrintArrayOnSingleLine(myArray As Variant)

    Dim counter     As Integer
    Dim textArray     As String
    
    For counter = LBound(myArray) To UBound(myArray)
        textArray = textArray & myArray(counter)
    Next counter
    
    Debug.Print textArray
    
End Sub

Sources (Disclaimer - from my blog):

• VBA Nested Loop with Recursion
• VBA All Combinations