I can't help you with Harlan's code. I wrote this a long time ago and it
appears to work with negatives. I believe it will suffice. It is limited to a
maximum of 10 elements in combination and a minimum of 9 values can be
selected. Text cannot be in the selection. If interested, copy and paste to a
standard code module and correct word wrap (text will turn red).

Tested only briefly with negatives just now. It was (if I have the correct
version) rigorously tested with positive values when written a few years ago,
then mothballed.

You will prompted for the target value. The macro will insert a new column
in the active sheet and will list all combinations found to meet the target
value in this form:

-10.44 + 0.45 + 1.54 + 11.11 + 12.22 + 14.94
-5.19 + 0.45 + 1.54 + 5 + 5.45 + 7.63 + 14.94
0.45 + 0.99 + 1.18 + 4.53 + 5 + 5.45 + 12.22

For testing purposes, if you put an equals sign (=) in front of each of the
above Excel will convert them to formulas. The cells will, in this case,
return the value 29.82.

Regards,
Greg


Option Explicit
Dim Abort As Boolean

Sub FindCombins()
Dim a As Long, b As Long, c As Long
Dim d As Long, e As Long, f As Long
Dim g As Long, h As Long, i As Long
Dim j As Long, x As Long, y As Long
Dim s1 As Long, s2 As Long, s3 As Long
Dim s4 As Long, s5 As Long, s6 As Long
Dim s7 As Long, s8 As Long, s9 As Long
Dim s10 As Long, col As Long
Dim Resp As Integer, Style As Integer
Dim v As Single, v0 As Single, Ar() As Double
Dim cell As Range
Dim txt As String, Title As String
Dim t1 As Date, t2 As Date

Title = "Find Combinations"
s1 = 0: s2 = 0: s3 = 0: s4 = 0: s5 = 0
s6 = 0: s7 = 0: s8 = 0: s9 = 0: s10 = 0
On Error GoTo SkipToHere
If Selection.Count < 9 Then
txt = "Error: A minimum of nine values must be selected !!! "
MsgBox txt, vbCritical, Title
Exit Sub
End If
txt = "This macro will find combinations of the current " & _
"cell selection that equal a specified value. " & vbCr & vbCr & _
"- A maximum of 10 elements in combination is supported" & vbCr & _
"- A minimum of 9 values must be selected" & vbCr & _
"- The selection need not be contiguous" & vbCr & _
"- Only numeric values must be selected" & vbCr & _
"- Duplicate values should be removed from the selection"
Style = vbInformation + vbOKCancel
Resp = MsgBox(txt, Style, Title)
If Resp = vbCancel Then Exit Sub

col = ActiveCell.Column
ReDim Ar(0 To Selection.Count)
Ar(0) = 0
i = 1
For Each cell In Selection.Cells
Ar(i) = cell.Value
i = i + 1
Next
Ar = SortArray(Ar)

Call FindDupes(Ar)
If Abort Then Exit Sub

txt = vbCr & vbCr & "Specify target value:"
With Application
v0 = .InputBox(txt, Title)
If v0 = 0 Then Exit Sub
.ScreenUpdating = False
End With
t1 = Now
ActiveCell.EntireColumn.Insert
x = 0
y = UBound(Ar)
'xxxxxxxxxxxx Start Loop xxxxxxxxxx
For a = s1 To y - 9: For b = a + s2 To y - 8
For c = b + s3 To y - 7: For d = c + s4 To y - 6
For e = d + s5 To y - 5: For f = e + s6 To y - 4
For g = f + s7 To y - 3: For h = g + s8 To y - 2
For i = h + s9 To y - 1: For j = i + s10 To y

v = Ar(a) + Ar(b) + Ar(c) + Ar(d) + Ar(e) + Ar(f) + Ar(g) + Ar(h) + Ar(i) +
Ar(j)
If v = v0 Then
x = x + 1
txt = GetText(Ar(a), Ar(b), Ar(c), Ar(d), Ar(e), Ar(f), Ar(g), Ar(h),
Ar(i), Ar(j))
Cells(x, col) = txt
txt = ""
ElseIf v v0 Then
Exit For
End If

s10 = 1: Next: s9 = 1: Next: s8 = 1: Next: s7 = 1: Next: s6 = 1: Next
s5 = 1: Next: s4 = 1: Next: s3 = 1: Next: s2 = 1: Next: s1 = 1: Next
'xxxxxxxxxxxx End Loop xxxxxxxxxxxxxx
SkipToHe
Columns(col).EntireColumn.AutoFit
t2 = Now
If x 65536 Then
txt = "Too many combinations found. Max capacity 65536. "
Style = vbExclamation
ElseIf x = 0 Then
'Columns(col).Delete
If Err.Number = 0 Then
txt = "No combinations were found equalling " & v0 & " "
Else
txt = "An error caused the macro to fail. " & vbCr & vbCr & _
"- Ensure that the selection does not include text" & vbCr & _
"- Ensure that a minimum of seven values are selected" & vbCr & _
"- Ensure that numeric values are not formated with apostrophes"
End If
Style = vbExclamation
Else
txt = "Combinations found equalling " & v0 & " = " & x & " " & _
vbCr & vbCr & _
"Hours = " & Hour(t2 - t1) & vbCr & _
"Minutes = " & Minute(t2 - t1) & vbCr & _
"Seconds = " & Second(t2 - t1)
Style = vbOKOnly
End If
ActiveCell.Select
Application.ScreenUpdating = True
MsgBox txt, Style, Title
End Sub
Private Function GetText(a As Double, b As Double, c As Double, d As Double, _
e As Double, f As Double, g As Double, h As Double, i As Double, j As
Double) As String
Dim Ar As Variant
Dim x As Integer
Dim t As String
Ar = Array(a, b, c, d, e, f, g, h, i, j)
For x = 9 To 0 Step -1
If Ar(x) = 0 Then Exit For
t = " + " & Ar(x) & t
Next
GetText = Right(t, Len(t) - 3)
End Function

Private Function SortArray(Ar As Variant) As Variant
Dim i As Integer, j As Integer
Dim Temp As Double
For i = LBound(Ar) To UBound(Ar) - 1
For j = (i + 1) To UBound(Ar)
If Ar(i) Ar(j) And Ar(i) < 0 Then
Temp = Ar(j)
Ar(j) = Ar(i)
Ar(i) = Temp
End If
Next j
Next i
SortArray = Ar
End Function
Private Sub FindDupes(Ar As Variant)
Dim i As Integer, ii As Integer, cnt As Integer
Dim val As Double
Dim ar2() As Variant
Dim ar3() As Variant
Dim txt As String, txt2 As String
Dim Style As Integer
Dim Resp As Integer
Dim Dupes As Boolean

Dupes = False
Abort = False
ii = 0
For i = LBound(Ar) + 1 To UBound(Ar)
If Ar(i) = Ar(i - 1) Then
Dupes = True
cnt = 0
val = Ar(i)
ReDim Preserve ar2(ii)
ReDim Preserve ar3(ii)
ar2(ii) = Ar(i)
Do Until Ar(i) < Ar(i - 1)
i = i + 1
cnt = cnt + 1
If i = UBound(Ar) Then Exit Do
Loop
ar3(ii) = cnt + 1
ii = ii + 1
End If
Next
If Not Dupes Then Exit Sub
For i = LBound(ar2) To UBound(ar2)
txt2 = txt2 & "Value: " & ar2(i) & " Repetitions: " & ar3(i) & vbCr
Next
txt = "Duplicate values found in selection:" & vbCr & txt2 & _
vbCr & vbCr & "The presence of duplicates will slow performance and serves
no purpose. " & _
vbCr & vbCr & "Continue ?"

Resp = MsgBox(txt, vbOKCancel + vbExclamation, "Find Combinations")
If Resp = vbCancel Then Abort = True
End Sub