Help please

M

mik00725

Hello all,

I'm trying to get a set of numbers from column (for example A1:A30) t
sum a given number.

Let me explain. In column "A" I have a set of different numbers on
number in each cell. A1 = 2; A2 = 5.5; A3 = 7; A4 = 8 and so on. Now
have the number 10 as my given number. How can excel pick or chose fro
the list the cells that adds up to my given number 10?

Any help will be much appreciatted, since eventhough I've given
simple example, imagine having about one thousand contracts and yo
want only the ones that adds up to certain amount.

:confused
 
B

BrianB

Not an easy task because you have to look at every possible numbe
combination. The following macro looks for a 3 number set. You wil
need similar ones for 2, 4,5, 6 etc. Hopefully you will get the ide
from this one.

With 100 numbers to check you will find that the 3-number one will tak
quite some time to run. The more numbers you check much longer still
Best to leave running overnight then.

Code
-------------------

'=== copy from here =============================
'- MACRO TO FIND A 3 NUMBER SET IN A LIST
'- TO MAKE A GIVEN TOTAL (in cell A1 - other numbers below)
'- add loops to adapt to different size sets
'- Brian Baulsom January 2003
'================================================
Option Base 1
Dim NumberSheet As Worksheet
Dim NumberList() As Variant
Dim N1 As Long
Dim N2 As Long
Dim n3 As Long
Dim LastRow As Long
Dim MyRow As Long
Dim CheckNumber As Double
Dim CheckSum As Double
Dim SetFound As Boolean
'---------------------------
Sub FIND_NUMBERS()
Application.Calculation = xlCalculationManual
Set NumberSheet = Worksheets("NumberSheet")
'- checknumber in cell A1
CheckNumber = NumberSheet.Range("A1").Value
LastRow = NumberSheet.Range("A65536").End(xlUp).Row
'- number array
ReDim NumberList(LastRow)
For r = 1 To LastRow
NumberList(r) = NumberSheet.Cells(r + 1, 1).Value
Next
'---------------------------------------------------
'- loops
'SET2
'If SetFound = True Then GoTo GetOut
SET3
If SetFound = True Then GoTo GetOut
'-----------------------------------------------------
MsgBox ("Total not found.")
GetOut:
Application.StatusBar = False
Application.Calculation = xlCalculationAutomatic
End Sub
'------------------------------------------------------------
'==========
Sub SET3()
'==========
SetFound = False
For N1 = 1 To LastRow
For N2 = N1 + 1 To LastRow
For n3 = N2 + 1 To LastRow
'------------------------------------------
'- check total
Application.StatusBar = _
" 3 Numbers " & N1 & ":" & N2 & ":" & n3
CheckSum = NumberList(N1) + NumberList(N2) + NumberList(n3)
If Abs(CheckNumber - CheckSum) < 1 Then
NumberSheet.Range("B1").Value = NumberList(N1)
NumberSheet.Range("B2").Value = NumberList(N2)
NumberSheet.Range("B3").Value = NumberList(n3)
MsgBox ("Please see results in column B")
SetFound = True
Exit Sub
End If
'-----------------------------------------
Next n3
Next N2
Next N1
End Sub
'=========================================================

-------------------
 
Top