Forum Discussion
KanwalNo1
May 25, 2024Iron Contributor
Allocating / Apportioning Challan Amounts to Different Receipts
(I Apologize Friends! I made the unpardonable mistake of uploading the wrong file here. Now I have Uploaded the correct file here. I sincerely apologize for the inconvenience ! Challan Allocation Ap...
- May 27, 2024
KanwalNo1 Thank you for providing the new file and additional clarification. The updated code below should do the trick for allocating amounts by ID and recording any shortages:
Option Explicit Sub AllocateReceipts() 'Clear the previous output range Application.ScreenUpdating = False Dim wsOutput As Worksheet Set wsOutput = Worksheets("ChallanAllocation") wsOutput.Range("A1").CurrentRegion.Offset(1).ClearContents 'Sort each table by id and date Dim loCha As ListObject, loRec As ListObject Set loCha = Worksheets("Challan").ListObjects("Challan") Set loRec = Worksheets("Receipts").ListObjects("Receipts") Call SortTable(loCha, 1, 3) Call SortTable(loRec, 1, 3) 'Load each table into an array Dim cha As Variant, rec As Variant cha = loCha.DataBodyRange.Value rec = loRec.DataBodyRange.Value 'Allocate receipts to challan amounts Dim arr(1 To 1, 1 To 6) As Variant, id As Variant, rowId As Long, i As Long, j As Long, k As Double rowId = 2 For i = 1 To UBound(rec, 1) ' check for new receipt id If rec(i, 1) <> id Then ' reset id and running total id = rec(i, 1) k = 0 End If ' validate receipt amount If rec(i, 4) > 0 Then ' loop through challan array until receipt amount has been exhausted For j = 1 To UBound(cha, 1) ' only allocate challan amounts with matching ids If cha(j, 1) = id And cha(j, 4) > 0 Then ' copy the transaction details to an array arr(1, 1) = rec(i, 1) '<-------------------------------------- ID arr(1, 2) = rec(i, 3) '<-------------------------------------- Receipt Date arr(1, 3) = IIf(cha(j, 4) < rec(i, 4), cha(j, 4), rec(i, 4)) ' Amount arr(1, 4) = arr(1, 3) + k '<---------------------------------- Running Total arr(1, 5) = cha(j, 2) '<-------------------------------------- CIN arr(1, 6) = cha(j, 3) '<-------------------------------------- CIN Date ' write the transaction array to the next output row wsOutput.Cells(rowId, 1).Resize(, 6).Value = arr rowId = rowId + 1 ' update the running total k = arr(1, 4) ' reduce the current amounts by the transaction amount cha(j, 4) = cha(j, 4) - arr(1, 3) rec(i, 4) = rec(i, 4) - arr(1, 3) If rec(i, 4) = 0 Then Exit For End If Next j ' verify receipt amount has been exhausted If rec(i, 4) > 0 Then ' record the shortage arr(1, 1) = rec(i, 1) '<--- ID arr(1, 2) = rec(i, 3) '<--- Receipt Date arr(1, 3) = rec(i, 4) '<--- Amount arr(1, 4) = arr(1, 3) + k ' Running Total arr(1, 5) = "Short" '<----- CIN arr(1, 6) = Null '<-------- CIN Date wsOutput.Cells(rowId, 1).Resize(, 6).Value = arr rowId = rowId + 1 k = arr(1, 4) End If End If Next i Application.ScreenUpdating = True End Sub Private Sub SortTable(table As ListObject, field1 As Long, field2 As Long) With table.Sort.SortFields .Clear .Add2 Key:=table.ListColumns(field1).Range, Order:=xlAscending .Add2 Key:=table.ListColumns(field2).Range, Order:=xlAscending End With With table.Sort .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With End Sub
Let me know how it goes. Cheers!
djclements
Jul 04, 2024Bronze Contributor
KanwalNo1 If you're still interested in a formula-based solution, PeterBartholomew1 's method is the way to go (with a few minor tweaks). By using the row numbers of each dataset for the Input and Output IDs, as opposed to the dates, you can use the INDEX function to pull the necessary columns from the original dataset and, with a few additional steps, generate the desired results.
The core elements of the following formula were taken from Peter's custom FIFO functions and customized to meet your specific needs:
=LET(
FIFO, LAMBDA(inAmt,outAmt,
LET(
inRows, ROWS(inAmt) + 1,
outRows, ROWS(outAmt) + 1,
inRecords, HSTACK(EXPAND(SEQUENCE(inRows),, 2, ""), VSTACK(0, SCAN(0, inAmt, LAMBDA(a,v, a + v)))),
outRecords, CHOOSECOLS(HSTACK(EXPAND(SEQUENCE(outRows),, 2, ""), VSTACK(0, SCAN(0, outAmt, LAMBDA(a,v, a + v)))), 2, 1, 3),
unionAll, SORT(VSTACK(inRecords, outRecords), 3),
inId, SCAN(1, CHOOSECOLS(unionAll, 1), LAMBDA(a,v, IF(v = "", a, v))),
outId, SCAN(1, CHOOSECOLS(unionAll, 2), LAMBDA(a,v, IF(v = "", a, v))),
amt, CHOOSECOLS(unionAll, 3),
netAmt, VSTACK(DROP(amt, 1), TAKE(amt, -1)) - amt,
total, SCAN(0, netAmt, LAMBDA(a,v, a + v)),
FILTER(HSTACK(inId, outId, netAmt, total), (outId < outRows) * (netAmt <> 0))
)
),
chaData, SORT(FILTER(Challan, Challan[Amount] > 0), {1,3}),
recData, SORT(FILTER(Receipts, Receipts[Amount] > 0), {1,4,3}),
chaID, CHOOSECOLS(chaData, 1),
recID, CHOOSECOLS(recData, 1),
REDUCE(
{"ID","Party","Receipt Date","Amount","Tax Amt","Running Total","CIN","CIN Date"},
UNIQUE(recID),
LAMBDA(p,v,
LET(
cha, FILTER(chaData, chaID = v, EXPAND(v,, COLUMNS(chaData), 0)),
rec, FILTER(recData, recID = v),
output, FIFO(CHOOSECOLS(cha, 4), CHOOSECOLS(rec, 5)),
recOut, INDEX(rec, CHOOSECOLS(output, 2), {1,3,4}),
amount, CHOOSECOLS(output, 3),
taxAmt, ROUND(amount * 0.001, 0),
runTtl, CHOOSECOLS(output, 4),
cId, CHOOSECOLS(output, 1),
chaOut, IF(cId > ROWS(cha), {"Short",""}, INDEX(cha, cId, {2,3})),
VSTACK(p, HSTACK(recOut, amount, taxAmt, runTtl, chaOut))
)
)
)
)
This method is far more efficient than my previous attempts to iterate through the records with SCAN and LAMBDA recursion, which suffered from significant calculation lag after just 100-200 rows of receipts:
=LET(
cha, SORT(FILTER(Challan, Challan[Amount] > 0), {1,3}),
chaID, CHOOSECOLS(cha, 1),
chaAmt, CHOOSECOLS(cha, 4),
rws, ROWS(cha),
rec, SORT(FILTER(Receipts, Receipts[Amount] > 0), {1,4,3}),
recID, CHOOSECOLS(rec, 1),
recAmt, CHOOSECOLS(rec, 5),
FIFO, LAMBDA(ME,text,
LET(
p, TAKE(--TEXTSPLIT(text, "|"),, -6),
prr, INDEX(p, 1),
pra, INDEX(p, 2),
pcr, INDEX(p, 3),
pca, INDEX(p, 4),
pur, INDEX(p, 5),
rr, prr + NOT(pra),
ra, IF(pra, pra, INDEX(recAmt, rr)),
rId, INDEX(recID, rr),
new, OR(NOT(pca), rId <> IF(pcr, INDEX(chaID, pcr), "")),
cr, IF(new, IF(pur = rws, 0, IFNA(XMATCH(rId, DROP(chaID, pur)) + pur, 0)), pcr),
ca, IF(new, IF(cr, INDEX(chaAmt, cr), 0), pca),
amt, IF(ca, MIN(ra, ca), ra),
txt, IF(rr = prr, text & "|", "") & TEXTJOIN("|",, rr, ra - amt, cr, MAX(ca - amt, 0), MAX(cr, pur), amt),
IF(amt = ra, txt, ME(ME, txt))
)
),
TEXT2COLS, LAMBDA(array,delimiter,
LET(
arr, delimiter & array & delimiter,
cols, SEQUENCE(, MAX(LEN(arr) - LEN(SUBSTITUTE(arr, delimiter, ))) / LEN(delimiter) - 1),
TEXTBEFORE(TEXTAFTER(arr, delimiter, cols), delimiter)
)
),
results, SCAN(TEXTJOIN("|",, SEQUENCE(1,6,0,0)), SEQUENCE(ROWS(rec)), LAMBDA(a,v, FIFO(FIFO, a))),
output, WRAPROWS(--TOCOL(TEXT2COLS(results, "|"), 2), 6),
recOut, INDEX(rec, CHOOSECOLS(output, 1), {1,3,4}),
amount, CHOOSECOLS(output, 6),
taxAmt, ROUND(amount * 0.001, 0),
runTtl, --TEXTAFTER(SCAN("|", CHOOSECOLS(recOut, 1) & "|" & amount, LAMBDA(a,v, LET(
id, TEXTBEFORE(v, "|"),
amt, TEXTAFTER(v, "|"),
id & "|" & IF(id = TEXTBEFORE(a, "|"), TEXTAFTER(a, "|") + amt, amt)))), "|"),
cId, CHOOSECOLS(output, 3),
chaOut, IF(cId, INDEX(cha, cId, {2,3}), {"Short",""}),
HSTACK(recOut, amount, taxAmt, runTtl, chaOut)
)
Enjoy!
KanwalNo1
Jul 04, 2024Iron Contributor
djclements People like you make our planet worth living.
I had even forgotten about the DAF solution myself. You remembered! Thanks for being here. Words are not enough to appreciate the sincerity and dedication. I will have a thorough look into the same.
But I must admit that I am worried for you now. You possess the same traits which also made me lose my sleep over things which appealed to my mind in a challenging way. Started to lose my health. Long hours of sitting without even noticing the eatables lying beside me. If you do something like this, please don't do it. Please take very good care of you! Please! Please! Please!
I had even forgotten about the DAF solution myself. You remembered! Thanks for being here. Words are not enough to appreciate the sincerity and dedication. I will have a thorough look into the same.
But I must admit that I am worried for you now. You possess the same traits which also made me lose my sleep over things which appealed to my mind in a challenging way. Started to lose my health. Long hours of sitting without even noticing the eatables lying beside me. If you do something like this, please don't do it. Please take very good care of you! Please! Please! Please!