VBA code: Just a little modification

[Arnolf]

Hello,
I have the below next Sixth Sense's code, that I found in:
http://www.mrexcel.com/board2/viewtopic.php?t=80690


The code displays the results:

cformat.xls
	A	B	C	D	E	F
1	list	Desired sum			possible combination	Sum
2	1	10			4+6=	10
3	2				2+3+5=	10
4	3				1+4+5=	10
5	4				1+3+6=	10
6	5				1+2+3+4=	10
7	6
8
9
10
11
12
13
14
15
Sheet1

Option Explicit
Dim n, k, q As Double
Dim Comblist() As String
Dim b()
Dim Ans() As Variant
Private Sub Comb(j, m As Integer)
Dim tmp, X
    If j > n Then
        tmp = ""
        For X = 1 To n
            tmp = tmp & b(X)
        Next X
        
        q = q + 1
        ReDim Preserve Comblist(UBound(Comblist) + 1) As String
        Comblist(UBound(Comblist)) = tmp

    Else
        If k - m< n - j + 1 Then
            b(j) = 0
            Comb j + 1, m
        End If
        If m< k Then
            b(j) = 1
            Comb j + 1, m + 1
        End If
    End If
End Sub

Sub Sumxxx()
Dim St, i, j, tmp, Tmp2, AnsCount, L, Res
Dim listx()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
n = Range("a65536").End(xlUp).Row - 1
Res = Range("b2").Value
q = 0
ReDim Comblist(0) As String
ReDim b(n)
ReDim listx(n)
ReDim Ans(0)
For k = 1 To n
Comb 1, 0
Next k
For i = 1 To n
    listx(i) = Range("a" & 1 + i).Value
Next i
AnsCount = 0
For i = LBound(Comblist) To UBound(Comblist)
    St = ""
    tmp = 0
    For j = 1 To Len(Comblist(i))
        tmp = tmp + Mid(Comblist(i), j, 1) * listx(j)
        If Mid(Comblist(i), j, 1) = 1 Then
            St = St & "+" & listx(j)
        End If
    Next j
    If tmp = Res Then 'Or (tmp >= 0.9 * Res And tmp<= 1.1 * Res) Then
        ReDim Preserve Ans(UBound(Ans) + 1)
        AnsCount = AnsCount + 1
        Ans(AnsCount) = St
    End If
Next i
Range("e2:f65536").Value = ""
For i = LBound(Ans) + 1 To UBound(Ans)
    Range("e" & i + 1).Value = "'" & Mid(Ans(i), 2, Len(Ans(i))) & "="
    Range("F" & i + 1).Value = "=" & Ans(i)
Next i
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Sub

 

[Arnolf]

But, I need modificate the code in order displays the results in the next way:

How can modificate that ?.

Your help is much appreciated
rgds,
Arnolf.


I need this:

combin.xls
	A	B	C	D	E	F	G	H	I	J
1	list	Desired sum			Sum	possible combination
2	1	10			10	4	6
3	2				10	2	3	5
4	3				10	1	4	5
5	4				10	1	3	6
6	5				10	1	2	3	4
7	6
8
9
10
11
12
13
14
15
Sheet 1

EDIT: There was an error in my screenshot (cell A8)

 

[Norie]

This seems to work.

Dim n, k, q As Double
Dim Comblist() As String
Dim b()
Dim Ans() As Variant
Private Sub Comb(j, m As Integer)
Dim tmp, X
    If j > n Then
        tmp = ""
        For X = 1 To n
            tmp = tmp & b(X)
        Next X
        
        q = q + 1
        ReDim Preserve Comblist(UBound(Comblist) + 1) As String
        Comblist(UBound(Comblist)) = tmp

    Else
        If k - m < n - j + 1 Then
            b(j) = 0
            Comb j + 1, m
        End If
        If m < k Then
            b(j) = 1
            Comb j + 1, m + 1
        End If
    End If
End Sub

Sub Sumxxx()
Dim St, i, j, tmp, Tmp2, AnsCount, L, Res
Dim listx()
Dim nums

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
n = Range("a65536").End(xlUp).Row - 1
Res = Range("b2").Value
q = 0
ReDim Comblist(0) As String
ReDim b(n)
ReDim listx(n)
ReDim Ans(0)
For k = 1 To n
Comb 1, 0
Next k
For i = 1 To n
    listx(i) = Range("a" & 1 + i).Value
Next i
AnsCount = 0
For i = LBound(Comblist) To UBound(Comblist)
    St = ""
    tmp = 0
    For j = 1 To Len(Comblist(i))
        tmp = tmp + Mid(Comblist(i), j, 1) * listx(j)
        If Mid(Comblist(i), j, 1) = 1 Then
            St = St & "+" & listx(j)
        End If
    Next j
    If tmp = Res Then 'Or (tmp >= 0.9 * Res And tmp <= 1.1 * Res) Then
        ReDim Preserve Ans(UBound(Ans) + 1)
        AnsCount = AnsCount + 1
        Ans(AnsCount) = St
    End If
Next i

Range("e2:Z65536").ClearContents

For i = LBound(Ans) + 1 To UBound(Ans)
    Range("e" & i + 1).Value = "=" & Ans(i)
    
    nums = Split(Ans(i), "+")
    For k = 1 To UBound(nums)
        Range("E" & i + 1).Offset(0, k) = nums(k)
    Next k
    
Next i

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Sub

 

[Arnolf]

Thank you Norie. Works a treat!.
rgds
Arnolf