Who owes who money algorithm in excel spreadsheet - excel

Question

I have a group of people who have different expenses during a period. Everybody has a balance after this period. It looks like this in excel:
Person A: 6
Person B: 10
Person C: -7,5
Person D: -8,5
After this period a settlement will take place. I currently do this by manually. This results in:
Person C pays 6 to person A.
Person C pays 1,5 to person B.
Person D pays 8,5 to person B.
Person A gets 6 from person C.
Person B gets 1,5 form person C.
Peron B gets 8,5 from person D.
(There are multiple solutions possible when more persons are involved.)
The problem is that I have to apply this procedure for a big group of people. So my question is: 'How to apply this 'who owes who'-procedure by using an excel spreadsheet algorithm or macro?'.

Answer 1

I made a excel version too but its in Open office. can you download that? The following macro might work on its own. If it does not should be something small. it works fine in OOO and is saved as a Excel 97/2000 workbook document.
'this might not be needed in Microsoft Excel, comment it out
Option VBASupport 1 'OWES
Option Explicit
'Cells(row, col),
Private Sub cmd1_Click()
'data is same sheet, from row 4, column 4
'row 4 has names in columns, so 4,4 has name 1, 4,5 has name 2
'row 5 has amounts spent like 6, -10
'output is in columns 3 and 5
dim i
dim j,s as String, sum1
s=""
'get number of cells used in row 4 and check if corresponding row 6 column has a number value too
i = 4
sum1=0
do while(cells(4,i).Value <> "" and i < 500)
j = CDbl(cells(5,i).Value)
sum1 = sum1 + j
if j <> cells(5,i).Value then
MsgBox "Col " & i & " not a number?"
End
end if
i=i+1
loop
if i > 499 then
Msgbox "too many cols"
End
end if
If sum1 > 0.3 or sum1 < -0.3 then
Msgbox "Sum is not near 0 :" & sum1
End
End if
Dim colCnt as Integer
colCnt = i - 4
cells (7,1).Value = "Col count = " & colCnt
Dim spent(colCnt) as Double
Dim owes1(colCnt ) as String
Dim owes2(colCnt ) as String
for i= 4 to colCnt + 3
spent(i - 3) = CDbl(cells(5,i).Value)
Next
Dim cnt,lastNeg, abs1,maxPay ' safety var for never ending loops, only if data bad like many cols and more than .1 diffs
lastNeg = 4
dim lastPay1
lastPay1 = 10
dim ii,jj,c1,c2,toPay
toPay = 0
On Local Error Goto errh
for i= 4 to colCnt + 3
cnt = 0
ii = i - 3
c1 = spent(ii)
'Cells(6,i) = "ok "
if spent(ii) > 0.1 and cnt < colCnt Then '//has to take
cnt = cnt + 1
for j = lastNeg to colCnt + 3 ' ; j < people.length && spent(ii) > 0.1; j++)
jj = j - 3
's = s & Me.Cells(ii,j) & " "
if spent(ii) > 0.1 then
if spent(jj) < -0.1 Then ' //has to give and has balance to give
c1 = spent(ii)
c2 = spent(jj)
lastNeg = j
abs1 = spent(jj) * -1'//can use absolute fn
maxPay = abs1
if(maxPay > spent(ii)) Then
toPay = spent(ii)'
else
toPay = abs1
End if
spent(ii) = spent(ii) - toPay
spent(jj) = spent(jj) + toPay
Cells(lastPay1, 3).Value = Cells(4 , j) & " pays " & toPay & " to " & Cells(4 , i )
Cells(lastPay1, 5).Value = Cells(4 , i) & " gets " & toPay & " from " & Cells(4 , j)
lastPay1 = lastPay1 + 1
End if
End if
Next
End if
Next
Msgbox "Done"
err.Clear
if err.Number <> 0 Then
errH:
dim yy
yy = msgBox("err " & err.Number & " " & err.Description & " Continue", 2)
if yy = vbYes Then
Resume Next
End IF
End IF
End Sub
Book at http://sel2in.com/prjs/vba/profile (owes)
Can see http://www.excel-vba.com/ , http://office.microsoft.com/en-in/training/get-in-the-loop-with-excel-macros-RZ001150634.aspx the help in excel was useful too (f1 inside macro editor, can select a keyword or type and get context sensitive help by pressing f1)

Answer 2

How important is the pairing of who owes what to who? The reason I ask - it's simple to figure out the total cost per person and then determine who owes money and who needs a refund. If one person can be the "banker", he can collect all the money due and disburse all the refunds.
Much simpler question, if you have somebody willing to be the banker.
Trying to pair everything up will quite possibly not result in an exact answer, or may require one or more people making payments to more than one person - as well as one or more people trying to collect from more than one other person.

Answer 3

See http://sel2in.com/pages/prog/html/owes.html
Javascript fn
<form>
Paste tab seperated list of people on first line, Second line has blanace - positive means they spent more than others, negative means other spent on them (they owe)
<br>
<textarea id=t1 rows=3 cols=70></textarea>
</form>
<button onclick=calcOwes() >Calc owes</button>
<br>
<b>Result:</b>
<div id=result>Will appear here if data is good</div>
<br>
<b>Parsed data for debug:</b>
<div id=data1>Will appear here if data is good</div>
<br>
<hr>
<script>
function calcOwes(){
/**
2013 Tushar Kapila
If Person A: 6
Person B: 10
Person C: -7,5
Person D: -8,5
Then Person C pays 6 to person A.
Person C pays 1,5 to person B.
Person D pays 8,5 to person B.
*/
s = document.getElementById("t1").value
var line = s.split("\n")
//v = confirm("Your Data looks okay?:\n" + s)
//if(!v){ return;}
if(s.length < 2 || s.indexOf("\n") < 0){
alert("No line sep ")
return
}
people = line[0].split("\t")
spent = line[1].split("\t")
spent2 = line[1].split("\t")
if(spent.length < 2){
alert("Bad data, no spent data " + spent.length + "; 0 " + spent[0] + "; 1 " + + spent[1])
return
}
if(people.length != spent.length){
alert("People and amounts do not tally. make sure no tabs inside names, spaces are okay")
return
}
sum = 0;
data1o = document.getElementById("data1")
data1o.innerHTML = "";
for(i = 0;i < people.length; i++){
spent[i] = spent[i].trim()
spent[i] = parseFloat(spent[i])
sum += spent[i]
s = (1 + i) + " \"" + people[i] + "\" :" + spent[i] + ";<br>"
data1o.innerHTML += s;
}
if(sum > 0.2 || sum < -0.2){
v = confirm("Sum (" + sum + ")is not zero continue?")
if(!v){return;}
}
lastNeg = 0;
payDetails = new Array();
getDetails = new Array();
lastPay = 0;
for(i = 0;i < people.length; i++){
cnt = 0;
if(spent[i] > 0.1 && cnt < people.length){//has to take
cnt++
for(j = lastNeg; j < people.length && spent[i] > 0.1; j++){
if(spent[j] < -0.1){//has to give and has balance to give
lastNeg = j;
abs1 = spent[j] * -1;//can use absolute fn
maxPay = abs1
if(maxPay > spent[i]){
toPay = spent[i];
}else{
toPay = abs1
}
spent[i] -= toPay
spent[j] += toPay
payDetails[lastPay] = people[j] + " pays " + toPay + " to " + people[i]
getDetails[lastPay] = people[i] + " gets " + toPay + " from " + people[j]
lastPay++;
}
}
}
}
s = ""
s2 = ""
for(i = 0;i < lastPay; i++){
s = s + payDetails[i] + "<br>"
s2 = s2 + getDetails[i] + "<br>"
}
document.getElementById("result").innerHTML = s + "<br>" + s2
}
</script>
<br>Sample input 1 (tabs there?)
<br><pre>
a b c d
6 10 -7.5 -8.5
</pre>
<br>Sample input 2
<pre>
Anna Dan Bobby Scareface Colly Doc Egg face
-6 10 -7.3 -8.33 11.67
</pre>