VBA code: Just a little modification

Arnolf

Board Regular
Joined
Sep 18, 2005
Messages
78
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
ABCDEF
1listDesired sumpossible combinationSum
21104+6=10
322+3+5=10
431+4+5=10
541+3+6=10
651+2+3+4=10
76
8
9
10
11
12
13
14
15
Sheet1




Code:
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
 

Excel Facts

Is there a shortcut key for strikethrough?
Ctrl+S is used for Save. Ctrl+5 is used for Strikethrough. Why Ctrl+5? When you use hashmarks to count |||| is 4, strike through to mean 5.

Arnolf

Board Regular
Joined
Sep 18, 2005
Messages
78
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
ABCDEFGHIJ
1listDesired sumSumpossible combination
21101046
3210235
4310145
5410136
65101234
76
8
9
10
11
12
13
14
15
Sheet 1



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

Norie

Well-known Member
Joined
Apr 28, 2004
Messages
76,351
Office Version
  1. 365
Platform
  1. Windows
This seems to work.
Code:
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
 
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,167,835
Messages
5,855,909
Members
431,772
Latest member
dannyboi1

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top