How is the criteria changed?
This cause an error:
Workbooks("Tracker.xls").Sheets("Purchase").Range( "H6").Value = 1

Function getSetTotal(sSet As String) As Currency
' Return the total purchases for sSet
'
Dim wsPurchase As Worksheet
Dim rDB As Range ' Database
Dim rColumn ' Database column to sum the amount for sSet
Dim rCriteria As Range
Dim total As Currency

Set wsPurchase = Worksheets("Purchase")
Set rDB = wsPurchase.Range("dbPURCHASE")
rColumn = "Amount"
Set rCriteria = wsPurchase.Range("H5:H6")
'Workbooks("Tracker.xls").Sheets("Purchase").Range ("H6").Value = 1

total = Application.WorksheetFunction.DSum(rDB, rColumn, rCriteria)
'MsgBox "total: " & total
getSetTotal = total
End Function