Results 1 to 2 of 2

Thread: No Remittance Advice - assistance with allocation
Thanks Thanks: 0 Likes Likes: 0

  1. #1
    New Member
    Join Date
    Apr 2019
    Post Thanks / Like
    0 Post(s)
    0 Thread(s)

    Default No Remittance Advice - assistance with allocation

    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

  2. #2
    Board Regular bobsan42's Avatar
    Join Date
    Jul 2010
    Bulgaria, GMT+2 (42.891813,25.313594)
    Post Thanks / Like
    6 Post(s)
    0 Thread(s)

    Default Re: No Remittance Advice - assistance with allocation

    Here is a file set up to do just that:
    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)
    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
        Set rng = Nothing
        Application.Calculation = xlCalculationAutomatic
        Application.StatusBar = "READY"
        Exit Sub
        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, 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)))
        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
                Call CombinationsNP(vElements, p, vresult, lRow, i + 1, iIndex + 1, targetSum)
            End If
        Next i
    End Sub
    "'s sad that in our blindness we gather thorns for flowers..."
    mostly using:
    windows 7 +10 (64-bit) / excel 2013 +2016 (32-bit) / access 2013 +2016 (32-bit) / some imagination & Google of course
    You don't need to read between the lines - just read them all!

Some videos you may like

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts