No Remittance Advice - assistance with allocation

HelpPlease1234

New Member
Good Afternoon.
Working in a finance department, we quite often get issuesthat payments are received, but we have no idea what invoice numbers have beenpaid in that particular payment. This is because the client has not provided aremittance advice (list of invoices they have paid).
I am wondering if there is a way in EXCEL in which you canfind all possible combinations of a set of values. If there is, then this wouldhelp determine which invoices have been paid.
If anyone can provide any assistance on this it would begreatly appreciated.
Many Thanks
 

bobsan42

Well-known Member
Here is a file set up to do just that: https://drive.google.com/file/d/13LZZefmUz_kaZlCy35nBj7NA_rPQC06M/view?usp=sharing
You have to allow macros, enter the invoice values in column A (from A2 down), enter Target sum in B2, then press the button.
in the columns to the left you will get the possible combinations (numbers are in order of appearance).
It was made some time ago in a hurry - it is not elegant or optimized, but works.
Do not give it large sets of data and have some patience :)

below is the code used in case you want to change it and adapt to your needs (this goes in a standard module, the routine to call is PowerSet)
Code:
Option Explicit
Option Compare Text




Public Sub CombineNumbers()
    Application.Calculation = xlCalculationManual
    Dim arrAllNumbers() As Single
    Dim arrCurrentNumbers() As Single
    Dim arrResults() As Single
    Dim RunningSum As Single
    Dim TargetValue As Single
    Dim i As Integer, j As Integer, k As Integer
    Dim rng As Range
    On Error GoTo errHandler
    TargetValue = Range("C2").Value
    Set rng = Range("A2").Resize(Cells(Rows.Count, 1).End(xlUp).Row - 1)
    ReDim arrAllNumbers(1 To rng.Rows.Count, 1)
    ReDim arrCurrentNumbers(1 To UBound(arrAllNumbers, 1), 1)
    
    arrAllNumbers = rng
'    Range("B2").Resize(UBound(arrAllNumbers, 1)) = arrAllNumbers
    For i = 1 To UBound(arrAllNumbers, 1)
        If arrAllNumbers(i) = TargetValue Then
        
        End If
    Next i
    
exitPoint:
    Set rng = Nothing
    Application.Calculation = xlCalculationAutomatic
    Application.StatusBar = "READY"
    Exit Sub
errHandler:
    MsgBox "Error occurred. " & vbCrLf & "Number: " & Err.Number & vbCrLf & Err.Description, _
            vbInformation + vbOKOnly
        Resume exitPoint
End Sub


Function ListPermut(num As Integer)
    'Permutations without repetition
    Dim c As Long, r As Long, p As Long
    Dim rng() As Long, temp As Long, i As Long
    Dim temp1 As Long, y() As Long, d As Long
    p = WorksheetFunction.Permut(num, num)
    ' Create array
    ReDim rng(1 To p, 1 To num)
    'Create first row in array (1, 2, 3, ...)
    For c = 1 To num
      rng(1, c) = c
    Next c
    For r = 2 To p
    ' 1. Find the first smaller number rng(r-1, c-1)<rng(r-1,c)
      For c = num To 1 Step -1
        If rng(r - 1, c - 1) < rng(r - 1, c) Then
          temp = c - 1
          Exit For
        End If
      Next c
    ' Copy values from previous row
      For c = num To 1 Step -1
        rng(r, c) = rng(r - 1, c)
      Next c
    ' 2. Find a larger number than rng(r-1, temp)as far to the right as possible
      For c = num To 1 Step -1
          If rng(r - 1, c) > rng(r - 1, temp) Then
              temp1 = rng(r - 1, temp)
              rng(r, temp) = rng(r - 1, c)
              rng(r, c) = temp1
              ReDim y(num - temp)
              i = 0
              For d = temp + 1 To num
                y(i) = rng(r, d)
                i = i + 1
              Next d
              i = 0
              For d = num To temp + 1 Step -1
                rng(r, d) = y(i)
                i = i + 1
              Next d
              Exit For
          End If
      Next c
    Next r
    ListPermut = rng
End Function






' PGC Oct 2007
' Calculates a Power Set
' Set in A1, down. Result in C1, down and accross. Clears C:Z.
Public Sub PowerSet()
    Application.Calculation = xlCalculationManual
    Dim vElements As Variant, vresult As Variant
    Dim lRow As Long, i As Long
    Dim vTarget As Single
    vTarget = Range("B2").Value
     
    vElements = Application.Transpose(Range("A2", Range("A2").End(xlDown)))
    Columns("D:ZZ").ClearContents
    
    lRow = 1
    For i = 1 To UBound(vElements)
        ReDim vresult(1 To i)
        Application.StatusBar = "Calculating combinations of " & i & " number(s)"
        Call CombinationsNP(vElements, i, vresult, lRow, 1, 1, vTarget)
    Next i
    Debug.Print "done"
    Application.Calculation = xlCalculationAutomatic
    Application.StatusBar = "READY"


End Sub
 
Sub CombinationsNP(vElements As Variant, p As Long, vresult As Variant, lRow As Long, iElement As Integer, iIndex As Integer, Optional targetSum As Single = 0)
    Dim i As Long
    Dim jRow As Long
    Dim kCol As Long
    Dim runSum As Single
    Dim vResult2() As Variant
     
    For i = iElement To UBound(vElements)
        vresult(iIndex) = vElements(i)
        If iIndex = p Then
            runSum = 0
            For jRow = LBound(vresult) To UBound(vresult)
                runSum = runSum + vresult(jRow)
'                Debug.Print vresult(jRow),
            Next jRow
'            Debug.Print runSum
            
            If runSum = targetSum Then
                lRow = lRow + 1
                Range("B4").Offset(, lRow).Resize(p) = Application.Transpose(vresult)
            End If
        Else
            Call CombinationsNP(vElements, p, vresult, lRow, i + 1, iIndex + 1, targetSum)
        End If
    Next i
End Sub
 

Some videos you may like

This Week's Hot Topics

  • Get External Data (long shot question!)
    This is likely a long shot but I am wondering if it is at all possible for Excel to somehow 'change' the contents of a URL that is being linked to...
  • Importing multiple excel files into one spreadsheet
    Hi, I'm trying to import multiple excel files (with the same format into a single spreadsheet) so that each day's file is listed underneath the...
  • Cell Formatting
    Good Morning, I need to format a few different cells in the following manners: A1 has to always add a colon (:) after whatever is typed in by a...
  • How to copy multiple rows using If
    Hi all, I'm very new to VBA and have written this simple code to copy certain cells if a certain cell within that row contains any data. I need...
  • Workbook_Change stopped working !
    I am working on an app to speed up & automate processing of Credit Cards statements. After data is input from a CSV file, it is presented to the...
  • VBA If statement
    Dear All, I have two dates, where I'd like a message box to pop, if the dates are between this criteria. [CODE] sDate1 = #10/1/2019#...
Top