I've found the code below, which will find all combinations of cells that add up to a certain number in Excel, but I'm getting the compile error regarding "Dictionary". It doesn't appear to be defined and I'm a newbie and not sure what I need to do to get it to work. See code below and thanks in advance.


Sub findsums()
'This *REQUIRES* VBAProject references to
  'Microsoft Scripting Runtime
  'Microsoft VBScript Regular Expressions 1.0 or higher
  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 Dictionary
  Dim dcn As Dictionary, dco As Dictionary
  Dim re As 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