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


New Member
Apr 26, 2007
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
        dfinalrow = Sheet3.Cells(Rows.Count, 1).End(xlUp).Row
        Sheet3.Cells(dfinalrow + 1, 1).Select
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).

please some one kindly help.

thanks alot.


  • Deal Sheet.JPG
    Deal Sheet.JPG
    81.5 KB · Views: 6
  • Settlement Sheet.JPG
    Settlement Sheet.JPG
    40.7 KB · Views: 5
  • Copiied Data.JPG
    Copiied Data.JPG
    77.6 KB · Views: 6

Some videos you may like

Excel Facts

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


New Member
Apr 26, 2007
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
    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
    rng.Offset(0, 7).Value = 0
    End If

End Sub

Waiting for someone to help.


Watch MrExcel Video

Forum statistics

Latest member