Below is the code from Harlan Grove.  Follow the instructions at the top concerning references, and
then run FindSums.  Note that it can take a looong time, depending on how many numbers you have.  It
will insert a new sheet with possilbe solutions.

HTH,
Bernie
MS Excel MVP

Option Explicit
'This *REQUIRES* VBAProject references to
 'Microsoft Scripting Runtime
 'Microsoft VBScript Regular Expressions 1.0
 'Written by Harlan Grove

Sub FindSums()
 Const TOL As Double = 0.000001  'modify as needed
 Dim c As Variant

 Dim j As Long, k As Long, n As Long, p As Boolean
 Dim s As String, t As Double, u As Double
 Dim v As Variant, x As Variant, y As Variant
 Dim dc1 As New Dictionary, dc2 As New Dictionary
 Dim dcn As Dictionary, dco As Dictionary
 Dim re As New RegExp

 re.Global = True
 re.IgnoreCase = True

 On Error Resume Next

 Set x = Application.InputBox( _
   Prompt:="Enter range of values:", _
   Title:="findsums", _
   Default:="", _
   Type:=8 _
 )

 If x Is Nothing Then
   Err.Clear
   Exit Sub
 End If

 y = Application.InputBox( _
   Prompt:="Enter target value:", _
   Title:="findsums", _
   Default:="", _
   Type:=1 _
 )

 If VarType(y) = vbBoolean Then
   Exit Sub
 Else
   t = y
 End If

 On Error GoTo 0

 Set dco = dc1
 Set dcn = dc2

 Call recsoln

 For Each y In x.Value2
   If VarType(y) = vbDouble Then
     If Abs(t - y) < TOL Then
       recsoln "+" & Format(y)

     ElseIf dco.Exists(y) Then
       dco(y) = dco(y) + 1

     ElseIf y < t - TOL Then
       dco.Add Key:=y, Item:=1

       c = CDec(c + 1)
       Application.StatusBar = "[1] " & Format(c)

     End If

   End If
 Next y

 n = dco.Count

 ReDim v(1 To n, 1 To 3)

 For k = 1 To n
   v(k, 1) = dco.Keys(k - 1)
   v(k, 2) = dco.Items(k - 1)
 Next k

 qsortd v, 1, n

 For k = n To 1 Step -1
   v(k, 3) = v(k, 1) * v(k, 2) + v(IIf(k = n, n, k + 1), 3)
   If v(k, 3) > t Then dcn.Add Key:="+" & Format(v(k, 1)), Item:=v(k, 1)
 Next k

 On Error GoTo CleanUp
 Application.EnableEvents = False
 Application.Calculation = xlCalculationManual

 For k = 2 To n
   dco.RemoveAll
   swapo dco, dcn

   For Each y In dco.Keys
     p = False

     For j = 1 To n
       If v(j, 3) < t - dco(y) - TOL Then Exit For

       x = v(j, 1)
       s = "+" & Format(x)
       If Right(y, Len(s)) = s Then p = True

       If p Then
         re.Pattern = "\" & s & "(?=(\+|$))"
         If re.Execute(y).Count < v(j, 2) Then
           u = dco(y) + x

           If Abs(t - u) < TOL Then
             recsoln y & s

           ElseIf u < t - TOL Then
             dcn.Add Key:=y & s, Item:=u

             c = CDec(c + 1)
             Application.StatusBar = "[" & Format(k) & "] " & Format(c)

           End If
         End If
       End If
     Next j
   Next y

   If dcn.Count = 0 Then Exit For
 Next k

 If (recsoln() = 0) Then _
   MsgBox Prompt:="all combinations exhausted", Title:="No Solution"

CleanUp:
 Application.EnableEvents = True
 Application.Calculation = xlCalculationAutomatic
 Application.StatusBar = False

End Sub

Private Function recsoln(Optional s As String)
 Const OUTPUTWSN As String = "findsums solutions"  'modify to taste

 Static r As Range
 Dim ws As Worksheet

 If s = "" And r Is Nothing Then
   On Error Resume Next
   Set ws = ActiveWorkbook.Worksheets(OUTPUTWSN)

   If ws Is Nothing Then
     Err.Clear
     Application.ScreenUpdating = False
     Set ws = ActiveSheet
     Set r = Worksheets.Add.Range("A1")
     r.Parent.Name = OUTPUTWSN
     ws.Activate
     Application.ScreenUpdating = False

   Else
     ws.Cells.Clear
     Set r = ws.Range("A1")

   End If

   recsoln = 0

 ElseIf s = "" Then
   recsoln = r.Row - 1
   Set r = Nothing

 Else
   r.Value = s
   Set r = r.Offset(1, 0)
   recsoln = r.Row - 1

 End If

End Function

Private Sub qsortd(v As Variant, lft As Long, rgt As Long)
 'ad hoc quicksort subroutine
 'translated from Aho, Weinberger & Kernighan,
 '"The Awk Programming Language", page 161

 Dim j As Long, pvt As Long

 If (lft >= rgt) Then Exit Sub

 swap2 v, lft, lft + Int((rgt - lft + 1) * Rnd)

 pvt = lft

 For j = lft + 1 To rgt
   If v(j, 1) > v(lft, 1) Then
     pvt = pvt + 1
     swap2 v, pvt, j
   End If
 Next j

 swap2 v, lft, pvt

 qsortd v, lft, pvt - 1
 qsortd v, pvt + 1, rgt
End Sub

Private Sub swap2(v As Variant, i As Long, j As Long)
 'modified version of the swap procedure from
 'translated from Aho, Weinberger & Kernighan,
 '"The Awk Programming Language", page 161

 Dim t As Variant, k As Long

 For k = LBound(v, 2) To UBound(v, 2)
   t = v(i, k)
   v(i, k) = v(j, k)
   v(j, k) = t
 Next k
End Sub

Private Sub swapo(a As Object, b As Object)
 Dim t As Object

 Set t = a
 Set a = b
 Set b = t
End Sub
'---- end VBA code ----