Oakwoodbespoke
New Member
- Joined
- Jun 27, 2023
- Messages
- 23
- Office Version
- 365
- Platform
- Windows
Hi,
I am working on a VBA that I found on the web, where I have a list of values (Money, Accounting) and I have a target value, i want it to be able to find the combination of values in the list to add up to the target value.
Basically they are invoice values, and I want to find the invoices values that add up to a value that has been taken from our business account.
I have the following but it only works with whole numbers ie £3,450.00, as soon as i have one that is say £4,567.45 its doesn't work.
I'm guessing it something to do with Integer
current code (it also has a user form for input)
Main Code
Code for user input
Many thanks in advance
I am working on a VBA that I found on the web, where I have a list of values (Money, Accounting) and I have a target value, i want it to be able to find the combination of values in the list to add up to the target value.
Basically they are invoice values, and I want to find the invoices values that add up to a value that has been taken from our business account.
I have the following but it only works with whole numbers ie £3,450.00, as soon as i have one that is say £4,567.45 its doesn't work.
I'm guessing it something to do with Integer
current code (it also has a user form for input)
Main Code
VBA Code:
Public RefArray1 As String
Public DS As Variant
Public TargetSum As integer
Public TargetCol As Integer
Public TargetRow As Integer
Sub FindAllCombinations()
UserForm1.Show
End Sub
Function GrayCode(Items As Variant) As String
Dim CodeVector() As Integer
Dim i, kk, rr, col1, row1, n1, e As Integer
Dim lower As Integer, upper As Integer
Dim SubList As String
Dim NewSub As String
Dim done As Boolean
Dim OddStep As Boolean
Dim SSS
Dim TargetArray() As String
kk = TargetCol
rr = TargetRow
col1 = TargetCol + 3
row1 = TargetRow
OddStep = True
lower = LBound(Items)
upper = UBound(Items)
Cells(rr - 1, kk) = "Result"
Cells(rr - 1, kk + 1) = "Sum"
Cells(rr, kk + 1) = TargetSum
Cells(rr - 1, kk).Font.Bold = True
Cells(rr - 1, kk + 1).Font.Bold = True
ReDim CodeVector(lower To upper) 'it starts all 0
Do Until done
NewSub = ""
For i = lower To upper
If CodeVector(i) = 1 Then
If NewSub = "" Then
NewSub = "," & Items(i)
SSS = SSS + Items(i)
Else
NewSub = NewSub & "," & Items(i)
SSS = SSS + Items(i)
End If
End If
Next i
If NewSub = "" Then NewSub = "{}" 'empty set
SubList = SubList & vbCrLf & NewSub
If SSS = TargetSum Then
Cells(rr, kk).NumberFormat = "@"
Cells(rr, kk) = "{ " & Mid(NewSub, 2) & " }"
TargetArray() = Split(Mid(NewSub, 2), ",")
n1 = UBound(TargetArray)
For e = 0 To n1
Cells(row1, col1) = TargetArray(e)
row1 = row1 + 1
Next e
col1 = col1 + 1
row1 = TargetRow
rr = rr + 1
End If
SSS = 0
'now update code vector
If OddStep Then
'just flip first bit
CodeVector(lower) = 1 - CodeVector(lower)
Else
'first locate first 1
i = lower
Do While CodeVector(i) <> 1
i = i + 1
Loop
'done if i = upper:
If i = upper Then
done = True
Else
'if not done then flip the *next* bit:
i = i + 1
CodeVector(i) = 1 - CodeVector(i)
End If
End If
OddStep = Not OddStep 'toggles between even and odd steps
Loop
GrayCode = SubList
End Function
Code for user input
VBA Code:
Private Sub CommandButton1_Click()
Dim B
Dim c As Integer
Dim d As Integer
Dim A() As Variant
Dim i As Integer
Dim e As Integer
DS = Range(RefEdit1)
TargetSum = TextBox1.Value
Range(RefEdit2).Select
TargetCol = Selection.Column
TargetRow = Selection.Row
c = LBound(DS)
d = UBound(DS)
ReDim B(d - 1)
For i = 1 To d
e = i - 1
B(e) = DS(i, 1)
Next i
Call GrayCode(B)
Unload Me
End Sub
Private Sub UserForm_Click()
End Sub
Many thanks in advance
Attachments
Last edited by a moderator: