Get all combinations of summing numbers - excel

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

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