Hi, does anyone know of a function or Marco that would find, out of a few
thousand cells, the two or more that add up to a specific #?

You could do a couple of things:

Enter
1525
in Cell A1

135
10000
500
550
1000
25
in cells B1:B6

Run this code:
Sub TestBldbin()
Dim i As Long
Dim bits As Long
Dim varr As Variant
Dim varr1() As Long
Dim rng As Range
Dim iCol As Long
Dim tot As Long
Dim num As Long
iCol = 0
Set rng = Range(Range("B1"), Range("B1").End(xlDown))
num = 2 ^ rng.Count - 1
bits = rng.Count
varr = rng.Value
ReDim varr1(0 To bits - 1, 0 To 0)
For i = 0 To num
bldbin i, bits, varr1
tot = Application.SumProduct(varr, varr1)
If tot = Range("A1") Then
iCol = iCol + 1
If iCol = 255 Then
MsgBox "too many columns, i is " & i & " of " & num & _
" combinations checked"
Exit Sub
End If
rng.Offset(0, iCol) = varr1
End If
Next
End Sub

***or***

Enter
8
6
3
2
6
10
9
4
12
8
6
1
8
10
8
14
10
9
12
12
14
6
4
3
4
4
4
0
6
10
4
9
6
3
11
12
10
7
12
8
8
in Cells A1:A41

90
in cell B1

Run this macro:
Sub FindSeries()

Dim StartRng As Range
Dim EndRng As Range
Dim Answer As Long
Dim TestTotal As Long

Answer = Range("B1") '<<< CHANGE

Set StartRng = Range("A1")
Set EndRng = StartRng
Do Until False
TestTotal = Application.Sum(Range(StartRng, EndRng))
If TestTotal = Answer Then
Range(StartRng, EndRng).Select
Exit Do
ElseIf TestTotal Answer Then
Set StartRng = StartRng(2, 1)
Set EndRng = StartRng
Else
Set EndRng = EndRng(2, 1)
If EndRng.Value = vbNullString Then
MsgBox "No series found"
Exit Do
End If
End If
Loop
End Sub


Regards,
Ryan---


--
RyGuy


"Jeff" wrote:

Hi, does anyone know of a function or Marco that would find, out of a few
thousand cells, the two or more that add up to a specific #?

See:

http://www.tushar-mehta.com/excel/te...ues/index.html


--
Gary''s Student - gsnu200781


"Jeff" wrote:

Hi, does anyone know of a function or Marco that would find, out of a few
thousand cells, the two or more that add up to a specific #?

Hello,

My favorite is still Michael Schwimmer's macro:
http://www.michael-schwimmer.de/vba096.htm

It stops with a first found solution and comes with a tolerance
parameter...

Regards,
Bernd

Awesome this was just what i needed thanks

"ryguy7272" wrote:

You could do a couple of things:

Enter
1525
in Cell A1

135
10000
500
550
1000
25
in cells B1:B6

Run this code:
Sub TestBldbin()
Dim i As Long
Dim bits As Long
Dim varr As Variant
Dim varr1() As Long
Dim rng As Range
Dim iCol As Long
Dim tot As Long
Dim num As Long
iCol = 0
Set rng = Range(Range("B1"), Range("B1").End(xlDown))
num = 2 ^ rng.Count - 1
bits = rng.Count
varr = rng.Value
ReDim varr1(0 To bits - 1, 0 To 0)
For i = 0 To num
bldbin i, bits, varr1
tot = Application.SumProduct(varr, varr1)
If tot = Range("A1") Then
iCol = iCol + 1
If iCol = 255 Then
MsgBox "too many columns, i is " & i & " of " & num & _
" combinations checked"
Exit Sub
End If
rng.Offset(0, iCol) = varr1
End If
Next
End Sub

***or***

Enter
8
6
3
2
6
10
9
4
12
8
6
1
8
10
8
14
10
9
12
12
14
6
4
3
4
4
4
0
6
10
4
9
6
3
11
12
10
7
12
8
8
in Cells A1:A41

90
in cell B1

Run this macro:
Sub FindSeries()

Dim StartRng As Range
Dim EndRng As Range
Dim Answer As Long
Dim TestTotal As Long

Answer = Range("B1") '<<< CHANGE

Set StartRng = Range("A1")
Set EndRng = StartRng
Do Until False
TestTotal = Application.Sum(Range(StartRng, EndRng))
If TestTotal = Answer Then
Range(StartRng, EndRng).Select
Exit Do
ElseIf TestTotal Answer Then
Set StartRng = StartRng(2, 1)
Set EndRng = StartRng
Else
Set EndRng = EndRng(2, 1)
If EndRng.Value = vbNullString Then
MsgBox "No series found"
Exit Do
End If
End If
Loop
End Sub


Regards,
Ryan---


--
RyGuy


"Jeff" wrote:

Hi, does anyone know of a function or Marco that would find, out of a few
thousand cells, the two or more that add up to a specific #?