Data Reconciliation Assistance Needed – Time Range & Sum Matching

Below a practical, ready-to-run VBA solution you can paste into your workbook.

Option Explicit

Sub FindCombinationsWithTimeFilter()
    ' Prompts: Target sum, Start datetime, End datetime, MaxItems, MaxResults, Tolerance
    Dim sTarget As String, sStart As String, sEnd As String
    Dim target As Double, startDT As Date, endDT As Date
    Dim maxItems As Long, maxResults As Long
    Dim tol As Double
    Dim ans As Variant
    
    sTarget = Application.InputBox("Target sum (numeric):", "Target Sum", Type:=1)
    If sTarget = False Then Exit Sub
    target = CDbl(sTarget)
    
    sStart = Application.InputBox("Start datetime (e.g. 2025-10-24 08:00):", "Start DateTime", Type:=2)
    If sStart = False Then Exit Sub
    On Error Resume Next
    startDT = CDate(sStart)
    If Err.Number <> 0 Then
        MsgBox "Invalid Start datetime.", vbExclamation
        Exit Sub
    End If
    On Error GoTo 0
    
    sEnd = Application.InputBox("End datetime (e.g. 2025-10-25 22:00):", "End DateTime", Type:=2)
    If sEnd = False Then Exit Sub
    On Error Resume Next
    endDT = CDate(sEnd)
    If Err.Number <> 0 Then
        MsgBox "Invalid End datetime.", vbExclamation
        Exit Sub
    End If
    On Error GoTo 0
    
    ans = Application.InputBox("Max items per combination (enter integer, e.g. 6):", "Max Items", Type:=1)
    If ans = False Then Exit Sub
    maxItems = CLng(ans)
    
    ans = Application.InputBox("Max number of results to return (e.g. 500):", "Max Results", Type:=1)
    If ans = False Then Exit Sub
    maxResults = CLng(ans)
    
    sTarget = Application.InputBox("Tolerance for equality (e.g. 0.01 for cents):", "Tolerance", Type:=1)
    If sTarget = False Then Exit Sub
    tol = CDbl(sTarget)
    
    Call FindCombinationsCore(target, startDT, endDT, maxItems, maxResults, tol)
End Sub


Sub FindCombinationsCore(target As Double, startDT As Date, endDT As Date, _
                         maxItems As Long, maxResults As Long, tol As Double)
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Data")
    
    Dim lastRow As Long
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    If lastRow < 2 Then
        MsgBox "No data found on sheet 'Data'.", vbExclamation
        Exit Sub
    End If
    
    Dim values() As Double, ids() As Variant, times() As Date
    Dim tempList() As Long
    Dim i As Long, c As Long
    c = 0
    
    ' Build candidate list by time filter
    For i = 2 To lastRow
        If IsDate(ws.Cells(i, "A").Value) Then
            Dim dt As Date
            dt = CDate(ws.Cells(i, "A").Value)
            If dt >= startDT And dt <= endDT Then
                ' ensure numeric
                If IsNumeric(ws.Cells(i, "B").Value) Then
                    ReDim Preserve values(c)
                    ReDim Preserve ids(c)
                    ReDim Preserve times(c)
                    values(c) = CDbl(ws.Cells(i, "B").Value)
                    ids(c) = IIf(ws.Cells(i, "C").Value = "", "R" & i, ws.Cells(i, "C").Value)
                    times(c) = dt
                    c = c + 1
                End If
            End If
        End If
    Next i
    
    If c = 0 Then
        MsgBox "No candidate rows found in the specified time range.", vbInformation
        Exit Sub
    End If
    
    ' Convert to 0-based compact arrays
    Dim n As Long
    n = c
    Dim valArr() As Double, idArr() As Variant
    ReDim valArr(0 To n - 1)
    ReDim idArr(0 To n - 1)
    For i = 0 To n - 1
        valArr(i) = values(i)
        idArr(i) = ids(i)
    Next i
    
    ' Sort candidates descending to help pruning (simple bubble/selection for clarity)
    Dim swapped As Boolean
    Dim j As Long
    For i = 0 To n - 2
        For j = i + 1 To n - 1
            If valArr(j) > valArr(i) Then
                Dim tVal As Double: tVal = valArr(i): valArr(i) = valArr(j): valArr(j) = tVal
                Dim tId As Variant: tId = idArr(i): idArr(i) = idArr(j): idArr(j) = tId
            End If
        Next j
    Next i
    
    ' Prepare output sheet
    Dim outS As Worksheet
    On Error Resume Next
    Set outS = ThisWorkbook.Worksheets("Combinations")
    If outS Is Nothing Then
        Set outS = ThisWorkbook.Worksheets.Add
        outS.Name = "Combinations"
    Else
        outS.Cells.Clear
    End If
    On Error GoTo 0
    
    outS.Range("A1").Value = "Combination #"
    outS.Range("B1").Value = "IDs (comma)"
    outS.Range("C1").Value = "Values (comma)"
    outS.Range("D1").Value = "Sum"
    
    ' Backtracking
    Dim current() As Long
    ReDim current(0 To n - 1)
    Dim combCount As Long: combCount = 0
    
    Application.StatusBar = "Searching combinations..."
    Application.ScreenUpdating = False
    Call RecurseFind(0, 0#, 0, valArr, idArr, n, target, tol, maxItems, maxResults, current, combCount, outS)
    Application.ScreenUpdating = True
    Application.StatusBar = False
    
    MsgBox "Search complete. " & combCount & " combinations found (max results allowed = " & maxResults & ")." _
           , vbInformation
End Sub


Sub RecurseFind(startIndex As Long, currentSum As Double, currentLen As Long, _
                ByRef valArr() As Double, ByRef idArr() As Variant, _
                n As Long, target As Double, tol As Double, _
                maxItems As Long, maxResults As Long, _
                ByRef current() As Long, ByRef combCount As Long, outS As Worksheet)
                
    Dim i As Long
    If combCount >= maxResults Then Exit Sub
    
    ' check equality
    If Abs(currentSum - target) <= tol And currentLen > 0 Then
        combCount = combCount + 1
        ' write row
        Dim r As Long: r = outS.Cells(outS.Rows.Count, "A").End(xlUp).Row + 1
        outS.Cells(r, "A").Value = combCount
        Dim idsList As String, valsList As String
        idsList = ""
        valsList = ""
        For i = 0 To currentLen - 1
            If i > 0 Then
                idsList = idsList & ", "
                valsList = valsList & ", "
            End If
            idsList = idsList & idArr(current(i))
            valsList = valsList & Format(valArr(current(i)), "0.######")
        Next i
        outS.Cells(r, "B").Value = idsList
        outS.Cells(r, "C").Value = valsList
        outS.Cells(r, "D").Value = Application.WorksheetFunction.Sum(Range(outS.Cells(r, "C").Address)) ' placeholder
        ' safer: compute sum directly
        Dim s As Double: s = 0
        For i = 0 To currentLen - 1
            s = s + valArr(current(i))
        Next i
        outS.Cells(r, "D").Value = s
        If combCount >= maxResults Then Exit Sub
        ' continue searching (maybe find other combos)
    End If
    
    If currentLen >= maxItems Then Exit Sub
    
    For i = startIndex To n - 1
        ' pruning: if currentSum + valArr(i) - target > tol and valArr(i) is positive, and all following are <= valArr(i),
        ' we can prune; but since we sorted descending, if currentSum + valArr(i) > target + tol AND valArr(i) > 0 then skip branch
        If valArr(i) >= 0 Then
            If currentSum + valArr(i) - target > tol Then
                ' if adding this single value already exceeds target by more than tol, skip to next because array is sorted descending
                ' but careful: smaller later values might still allow combinations; so we skip only this value and continue loop
                ' (no early return because later items are smaller)
                ' allow the algorithm to continue with next i
            End If
        End If
        
        current(currentLen) = i
        RecurseFind i + 1, currentSum + valArr(i), currentLen + 1, valArr, idArr, n, target, tol, maxItems, maxResults, current, combCount, outS
        If combCount >= maxResults Then Exit Sub
    Next i
End Sub

My answers are voluntary and without guarantee!

Hope this will help you.