Find the combination of numbers that when added equal a reqired total??

  • Thread starter Thread starter Handsy11
  • Start date Start date
H

Handsy11

Hey all,

Not sure if this can be done using functions or if it requires a macr
but here goes...

I have a long list of numbers relating to invoice totals.....I need t
know which combination of numbers would equal the total given to me fo
invoices charged at a particular rate of tax.....

To provide an simplified example:

I have ten numbers referring to invoice totals: 100, 45, 2000, 50, 11
2020, 66, 3333, 1265, 88

I know that the total for invoices charged at a rate of 21% = 5419

I want to know is there a way of creating a function (or macro) tha
would identify that the combination of 2020 + 66 + 3333 would give m
the required total???

Does that make sense??If not tell me and Ill try to simplify o
elaborate as required...

I would really appreciate any help...

Thanks in advanc
 
this is something that people ask fairly often.
Is is doable? Sometimes
What often happens is that when there are a lot of numbers in the file,
there are several or a lot of unwanted combinations which will equal one of
the totals.

algorithms which make a match and remove that data from the data set, are
normally left with unmatchable numbers for the last of the combinations.
Occassionally there can be an algorithm working to eleimainate unique
combinations before they try to balance the rest of the possible
combinations.
If you have just a few numbers, you could try writing some macros to try to
do the job.

The first time I tried to set up a macro to try to do this, there were a
couple of thousand data points for about 200 totals, and I calculated the
full brute force calculation would be done about when gy great grandchildren
would be out of college. (I don't have any grandchildren yet.)
 
Yeah I know where your coming from....I only had less than two hundred
data points and six totals to calculate to start with....I have done
the majority of the work manually and so am only left with less than
one hundred data points and four totals so a macro might be
useful.....I am familiar with Vb but have never written a
macro.....Could anyone guide me as to how I might write a macro to
solve this problem??
 
This sounded too interesting not to give it a try. I hope I understand
your problem correctly. The brute force way is to use recursion. It
has been said that to learn recursion, you already have to understand
recursion, so I won't explain it much :-) .

The setup:
The source numbers (100, 45, 2000, 50, 11 etc) must be in column a,
starting at A1, of a sheet named "source". They must be sorted
decending (highest at the top). All the totals starting at C1 and
below. It will stop at the first blank cell in each column.

a b c
3333 5419
2020 2061
2000 etc..
1265
etc

Also need a blank sheet called "Scratchpad" and one called "Results"
For each total, the sub "Main" calls the sub "CheckTotal" for each value
in col A. Checktotal checks each value below in column A and keeps
calling itself recursively until it checks every combination. Seems to
work with the limited test data I used. Each row in the results sheet
will start with the total, then the various values that make up that total.
I used integer variables for the data. If you have decimal data, or
values above 32767, use single (or double) or long variables. Be
careful with roundoff errors using single or double. What looks equal
might not be to excel.

It's cheap and dirty, and I'm sure I could clean it up, but it works.
Probably take hours to run with 200 numbers in column a. Give it a try
with a small data set first. I am assuming you know how to put in a
macro and run it. If not, reply and I or someone will give you more
details.

Len


Sub main()

Dim intTotal As Integer
Dim lngTotalRow As Integer
Dim lngCurrentRow As Long
'comment the following line to watch the action, but will be slower
Application.ScreenUpdating = False
'clear scratchpad
Worksheets("Scratchpad").Select
Cells.Select
Selection.ClearContents
Range("A1").Select

'clear results
Worksheets("Results").Select
Cells.Select
Selection.ClearContents
Range("A1").Select

lngTotalRow = 1
Worksheets("source").Activate

Do While Not IsEmpty(Cells(lngTotalRow, 3))
intTotal = Cells(lngTotalRow, 3).Value

Worksheets("Scratchpad").Select
Range("A1").Activate
ActiveCell.Value = intTotal
Worksheets("Source").Activate
lngCurrentRow = 1
Do While Not IsEmpty(Cells(lngCurrentRow, 1))
'start at each value and check all combos below it
CheckTotal intTotal, lngCurrentRow
lngCurrentRow = lngCurrentRow + 1
Worksheets("Source").Activate
Loop
'set up for the next total
lngTotalRow = lngTotalRow + 1
Worksheets("source").Activate
Loop
Worksheets("results").Activate
Application.ScreenUpdating = True

End Sub

Private Sub CheckTotal(ByVal intTotal As Integer, ByVal lngStartRow As Long)

'Recursive sub to find if all previous calls plus this one equal
the total
'If so, put result in the Results sheet
'Source data must be in column a of source sheet and
' must be sorted decending

Dim lngCurrentRow As Long
Dim intI As Integer

Worksheets("Source").Activate
intI = Cells(lngStartRow, 1).Value
If intI <= intTotal Then
'not too high, so write it to scratchpad
Worksheets("scratchpad").Activate
ActiveCell.Offset(0, 1).Activate
ActiveCell.Value = intI
If intI = intTotal Then
'have a match, save the results
Worksheets("Results").Activate
Cells(ActiveCell.Row + 1, 1).Activate
Worksheets("Scratchpad").Activate
Rows(1).Select
Selection.Copy
Worksheets("Results").Paste
Application.CutCopyMode = False
'remove the lowest number from the scratchpad
Cells(1, 1).Select
Selection.End(xlToRight).Select
ActiveCell.Delete
ActiveCell.Offset(0, -1).Activate
Else
'intI is less than total, get some more
'The recursive part
Worksheets("Source").Activate
lngCurrentRow = lngStartRow + 1
Do While Not IsEmpty(Cells(lngCurrentRow, 1))
CheckTotal intTotal - intI, lngCurrentRow
lngCurrentRow = lngCurrentRow + 1
Worksheets("Source").Activate
Loop
'remove the lowest number from scratchpad,
Worksheets("Scratchpad").Activate
ActiveCell.Delete
ActiveCell.Offset(0, -1).Activate
End If
End If
End Sub
 
Only just saw your reply there as I wasnt very hopeful of a practica
solution!!Finishing up in work now but I will give it a go in th
morning and let you know how I get on....Really appreciate you
help....Thanks a million,

Dyla
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Back
Top