Function to return an array in VBA

You could probably get the invoice numbers simply with a VLOOKUP but here is a VBA solution. I have changed the values in the Sofar collection from invoice amounts to the index number for that amount. That index number then gives the corresponding invoice number from a new array InvNo.

Update - Sorted by due date

Sub cmbCalculate_Click()

    Dim ws As Worksheet, dAmounts() As Double, sInvno() As String
    Dim i As Long, dSum As Double
    Dim dtDue() As Date
   
    Set ws = Me
    i = ws.Cells(Rows.Count, "A").End(xlUp).Row
    ReDim dAmounts(1 To i - 1)
    ReDim sInvno(1 To i - 1)
    ReDim dtDue(1 To i - 1)

   ' fill array
    For i = 1 To UBound(dAmounts)
        dAmounts(i) = ws.Cells(i + 1, "A")
        sInvno(i) = ws.Cells(i + 1, "B")
        dtDue(i) = ws.Cells(i + 1, "C")
        dSum = dSum + dAmounts(i)
    Next
    ' sort array
    Call BubbleSort(dAmounts, sInvno, dtDue)
    Dim n: For n = LBound(dAmounts) To UBound(dAmounts): Debug.Print n, dAmounts(n), sInvno(n), dtDue(n): Next

    Dim dGoal As Double, dTolerance As Double, vResult As Variant
    dGoal = ws.Range("D2")
    dTolerance = ws.Range("E2")

    ' check possible
    If dGoal > dSum Then
         MsgBox "Error : Total for Invoices " & Format(dSum, "#,##0.00") & _
         " is less than Goal " & Format(dGoal, "#,##0.00")
    Else
        ' solve and write to sheet
        vResult = Combinations2(dAmounts, sInvno, dtDue, dGoal, dTolerance)
        If IsArray(vResult) Then
            With ws
                .Range("F3:H" & Rows.Count).ClearContents
                .Range("F3").Resize(UBound(vResult), 3) = vResult
            End With
            MsgBox "Done"
        Else
            MsgBox "Cannot find suitable combination", vbCritical
        End If
     End If

End Sub


Function Combinations2( _
    Elements As Variant, _
    Invno As Variant, _
    Due As Variant, _
    Goal As Double, _
    Optional Tolerance As Double, _
    Optional SoFar As Variant, _
    Optional Position As Long) As Variant

    Dim i As Long, n As Long, dCompare As Double

    ' summate so far
    If IsMissing(SoFar) Then
        Set SoFar = New Collection
    Else
        For i = 1 To SoFar.Count
            dCompare = dCompare + Elements(SoFar(i))
        Next
    End If

    If Position = 0 Then Position = LBound(Elements)
    For i = Position To UBound(Elements)

        SoFar.Add CStr(i)
        dCompare = dCompare + Elements(i)

        ' check if target achieved
        If Abs(Goal - dCompare) < (0.001 + Tolerance) Then

            'Goal achieved
            Dim vResult As Variant
            ReDim vResult(1 To SoFar.Count, 1 To 3)
            For n = 1 To SoFar.Count
               vResult(n, 1) = Elements(SoFar(n))
               vResult(n, 2) = Invno(SoFar(n))
               vResult(n, 3) = Due(SoFar(n))
            Next
            Combinations2 = vResult
    
        ElseIf dCompare < (Goal + 0.001 + Tolerance) Then
            'Enough room for another element
            'Call recursively starting with next higher amount
            vResult = Combinations2(Elements, Invno, Due, Goal, Tolerance, SoFar, i + 1)
            If IsArray(vResult) Then
                 Combinations2 = vResult
                 Exit For
            Else
                 SoFar.Remove SoFar.Count
                 dCompare = dCompare - Elements(i)
            End If
        Else
      
            'Amount too high
            SoFar.Remove SoFar.Count
            Exit For
       End If
    Next
End Function

Sub BubbleSort(ByRef ar1 As Variant, ByRef ar2 As Variant, ByRef ar3 As Variant)
   ' sort both arrays
   Dim d, s, i As Long, k As Long, dt As Date
   For i = 1 To UBound(ar1)
       For k = i + 1 To UBound(ar1)
           If (ar1(k) < ar1(i)) Or _
              (ar1(k) = ar1(i) _
           And ar3(k) < ar3(i)) Then
               d = ar1(i)
               ar1(i) = ar1(k)
               ar1(k) = d
               s = ar2(i)
               ar2(i) = ar2(k)
               ar2(k) = s
               dt = ar3(i)
               ar3(i) = ar3(k)
               ar3(k) = dt
           End If
       Next
   Next
End Sub