# Loan Deals and partial Payments and identify profits copy paid once to another sheet.

#### ifraz

##### New Member
Hi Everyone

i am put in a huge in my company. where have to calculate the profits of every settlements done. Data provided to me is huge. but the example provided here to get the idea is simple.

i have the repayment plan of all the customers and in another sheet i have the settlements of it. as we know customers do not settle as per payment plan. settlements are done in part and some time even after maturity date, which is difficult to find for which month the customer has paid.

okay, now, for profit purpose, say i have total paid amount for every deal, now i need is, find the deal in repayment plan sheet deduct every month until paid amount for that specific deal is zero, and for every deal settled and no balance in the repayment plan, then copy the whole row to another sheet, so that i can take their profits.

show i have got this far.

VBA Code:
``````Sub Balance()
Dim dfinalrow As String
Dim deal As String
Dim i As Integer
Dim j As Integer
Dim k As Range
Dim m As Range

For i = 2 To Sheet1.Cells(Rows.Count, 1).End(xlUp).Row
For j = 2 To Sheet2.Cells(Rows.Count, 1).End(xlUp).Row
Set k = Range("A:A").Find(what:=j, LookIn:=xlValues, lookat:=xlWhole)
If Not k Is Nothing Then
Set m = Sheet2.Range("A:A").Find(what:=j, LookIn:=xlValues, lookat:=xlWhole)
Sheet2.Range("D" & j).Cells = Sheet1.Range("E" & i).Value - k.Range("C" & j).Value
End If
Next
Sheet1.Rows(i).Copy
Sheet3.Activate
dfinalrow = Sheet3.Cells(Rows.Count, 1).End(xlUp).Row
Sheet3.Cells(dfinalrow + 1, 1).Select
Sheet3.Paste

Next
End Sub``````

the above code just copies, all the data from Sheet1 (Deals) with the deal number available in the Sheet2 (Settlements) to Sheet3 (Copied Data), but, what i want is, for every loop subtract the Paid amount from Total Deal amount of in sequence until the deal amount can accommodate the total paid amount, and only those accommodated deals from Sheet1 (Deal) to be copied to Sheet3 (Copied Data).

thanks alot.

### Excel Facts

Repeat Last Command
Pressing F4 adds dollar signs when editing a formula. When not editing, F4 repeats last command.

#### ifraz

##### New Member
hi everyone,

i tried the below code, it nearly worked, but doesn't loop by updating the new balance in sheet2 and when the balance becomes zero, the profit should be zero for relevant rows.

VBA Code:
``````Sub test3()
Dim rng As Range
Dim i As Integer

Dim rngS As Range
Dim j As Integer

Dim tot As Long
Dim bal As Long
Dim paid As Long

With ThisWorkbook.Worksheets("Deals")
lastr = .Cells(.Rows.Count, "A").End(xlUp).Row
Set rng = Sheet1.Range("A2:A" & lastr)
End With

With ThisWorkbook.Worksheets("Settlements")
lastrs = .Cells(.Rows.Count, "A").End(xlUp).Row
Set rngS = Sheet2.Range("A2:A" & lastrs)
End With

For i = 2 To rng.Rows.Count
tot = rng.Cells(RowIndex:=i, ColumnIndex:=7).Value

For j = 2 To rngS.Rows.Count
paid = rngS.Cells(RowIndex:=j, ColumnIndex:=3).Value
bal = rngS.Cells(RowIndex:=j, ColumnIndex:=4).Value
bal = bal - tot
Next
bal = bal - tot
Debug.Print bal
rngS.Offset(0, 3).Value = bal + tot
If paid > tot Then
rng.Offset(0, 7).Value = rng.Offset(0, 3).Value
Else
rng.Offset(0, 7).Value = 0
End If
Next

End Sub``````

Waiting for someone to help.

thanks

Replies
4
Views
82
Replies
29
Views
526
Replies
12
Views
501
Replies
12
Views
240
Replies
1
Views
172