[Solved] Motor accident cases compensation programme in excel

M

marudhu1973

New member
The key fields are Case Number, Date of Deposit of award amount by Insurance company, Amount deposited, Amount disbursed to Parties P1, P2, P3, etc.,, and Balance.

Need a data entry form to enter particulars in the above field and they should append in a separate excel sheet.

Based on the data stored in the excel sheet, report need to be generated regarding the amount received, disbursed and balance amount in each and every case date wise.

that is all.

Kindly pls help with coding and formulas pls. It will be helpful in my career in my office.
 

Attachments

  • Sample.xlsx
    9.7 KB · Views: 1
marudhu1973 said:
The key fields are Case Number, Date of Deposit of award amount by Insurance company, Amount deposited, Amount disbursed to Parties P1, P2, P3, etc.,, and Balance.

Need a data entry form to enter particulars in the above field and they should append in a separate excel sheet.

Based on the data stored in the excel sheet, report need to be generated regarding the amount received, disbursed and balance amount in each and every case date wise.

that is all.

Kindly pls help with coding and formulas pls. It will be helpful in my career in my office.
Click to expand...
Hello Marudhu1973

Thanks for reaching out and posting your query. The requirement you mentioned can easily be solved with Excel VBA's help. Currently, I am designing the Data Entry form. Later, I have to start the coding part. However, implementing the Data Entry form and Report will take almost half a day.

When I am done, I will share the ideas in this thread. So, stay with ExcelDemy Forum and good luck.

Regards
Lutfor Rahman Shimanto
 
marudhu1973 said:
The key fields are Case Number, Date of Deposit of award amount by Insurance company, Amount deposited, Amount disbursed to Parties P1, P2, P3, etc.,, and Balance.

Need a data entry form to enter particulars in the above field and they should append in a separate excel sheet.

Based on the data stored in the excel sheet, report need to be generated regarding the amount received, disbursed and balance amount in each and every case date wise.

that is all.

Kindly pls help with coding and formulas pls. It will be helpful in my career in my office.
Click to expand...
Dear Marudhu1973

I hope this post will find you well. As per request, I have implemented the model mentioned below.

You wanted a Data Entry form that will append data in individual sheets. I have implemented it as you wanted. In my view, that is not necessary at this stage. Also, you did not mention any specific requirements for reports. However, I have generated some reports that may suit your dataset.

Excel VBA Code (UserForm1):
You will find the codes in the next reply, as we can only reply within 10000 words.
Excel VBA Code (UserForm2):
Code: 
Private Sub UserForm_Initialize()
 
    Call displayReports
    Call ShowCreditDisbursalBalance
 
End Sub

Sub displayReports()
 
    On Error Resume Next
    Dim dSP As Worksheet
    Dim lstRow As Integer
 
    Set dSP = ThisWorkbook.Sheets("Summary")
 
    lstRow = dSP.Cells(Rows.Count, 1).End(xlUp).Row
 
    With Me.ListBox1
        .ColumnCount = 12
        .ColumnHeads = True
        .ColumnWidths = "40, 80, 0, 0, 0, 40, 30, 30, 30, 30, 90, 60"
        .RowSource = dSP.Name & "!A3:L" & lstRow
    End With

End Sub

Sub ShowCreditDisbursalBalance()
 
    Dim wsCredit, wsBalance As Worksheet
    Dim P1, P2, P3, P4 As Worksheet
    Dim creditRng, balanceRng As Range
    Dim lstRowCredit, lstRowBalance, lstP1, lstP2, lstP3, lstP4 As Long
    Dim d1, d2, d3, d4, disbursal As Long
 
    Set wsCredit = ThisWorkbook.Sheets("Credit")
    Set wsBalance = ThisWorkbook.Sheets("Balance")
    Set P1 = ThisWorkbook.Sheets("Disbursal to P1")
    Set P2 = ThisWorkbook.Sheets("Disbursal to P2")
    Set P3 = ThisWorkbook.Sheets("Disbursal to P3")
    Set P4 = ThisWorkbook.Sheets("Disbursal to P4")
 
    lstRowCredit = wsCredit.Cells(Rows.Count, 1).End(xlUp).Row
    lstRowBalance = wsBalance.Cells(Rows.Count, 1).End(xlUp).Row
    lstP1 = P1.Cells(Rows.Count, 1).End(xlUp).Row
    lstP2 = P2.Cells(Rows.Count, 1).End(xlUp).Row
    lstP3 = P3.Cells(Rows.Count, 1).End(xlUp).Row
    lstP4 = P4.Cells(Rows.Count, 1).End(xlUp).Row
 
    creditRng = wsCredit.Range("A2:A" & lstRowCredit)
    Me.txtCredit.Value = Application.WorksheetFunction.Sum(creditRng)
 
    Me.txtBalance.Value = wsBalance.Range("A" & lstRowBalance).Value
 
    d1 = Application.WorksheetFunction.Sum(P1.Range("A" & lstP1))
    d2 = Application.WorksheetFunction.Sum(P2.Range("A" & lstP2))
    d3 = Application.WorksheetFunction.Sum(P3.Range("A" & lstP3))
    d4 = Application.WorksheetFunction.Sum(P4.Range("A" & lstP4))
 
    disbursal = d1 + d2 + d3 + d4
 
    Me.txtDisbursal.Value = disbursal
 
End Sub
Excel VBA Code (Module1):
Code: 
Sub DataEntry()
 
    UserForm1.Show
 
End Sub

Sub Reports()
 
    UserForm2.Show
 
End Sub
Data Entry:
DataEntry.png​
Reports:
Reports.png​

Thank you for reaching out. I have attached the solution Workbook with you. Please let me know if you have any further questions or if there's anything else I can assist you with.

Regards
Lutfor Rahman Shimanto
 

Attachments

  • Marudhu1973.xlsm
    65.7 KB · Views: 0
Last edited:
Lutfor Rahman Shimanto said:
Dear Marudhu1973

I hope this post will find you well. As per request, I have implemented the model mentioned below.

You wanted a Data Entry form that will append data in individual sheets. I have implemented it as you wanted. In my view, that is not necessary at this stage. Also, you did not mention any specific requirements for reports. However, I have generated some reports that may suit your dataset.

Excel VBA Code (UserForm1):
You will find the codes in the next reply, as we can only reply within 10000 words.
Excel VBA Code (UserForm2):
Code: 
Private Sub UserForm_Initialize()
 
    Call displayReports
    Call ShowCreditDisbursalBalance
 
End Sub

Sub displayReports()
 
    On Error Resume Next
    Dim dSP As Worksheet
    Dim lstRow As Integer
 
    Set dSP = ThisWorkbook.Sheets("Summary")
 
    lstRow = dSP.Cells(Rows.Count, 1).End(xlUp).Row
 
    With Me.ListBox1
        .ColumnCount = 12
        .ColumnHeads = True
        .ColumnWidths = "40, 80, 0, 0, 0, 40, 30, 30, 30, 30, 90, 60"
        .RowSource = dSP.Name & "!A3:L" & lstRow
    End With

End Sub

Sub ShowCreditDisbursalBalance()
 
    Dim wsCredit, wsBalance As Worksheet
    Dim P1, P2, P3, P4 As Worksheet
    Dim creditRng, balanceRng As Range
    Dim lstRowCredit, lstRowBalance, lstP1, lstP2, lstP3, lstP4 As Long
    Dim d1, d2, d3, d4, disbursal As Long
 
    Set wsCredit = ThisWorkbook.Sheets("Credit")
    Set wsBalance = ThisWorkbook.Sheets("Balance")
    Set P1 = ThisWorkbook.Sheets("Disbursal to P1")
    Set P2 = ThisWorkbook.Sheets("Disbursal to P2")
    Set P3 = ThisWorkbook.Sheets("Disbursal to P3")
    Set P4 = ThisWorkbook.Sheets("Disbursal to P4")
 
    lstRowCredit = wsCredit.Cells(Rows.Count, 1).End(xlUp).Row
    lstRowBalance = wsBalance.Cells(Rows.Count, 1).End(xlUp).Row
    lstP1 = P1.Cells(Rows.Count, 1).End(xlUp).Row
    lstP2 = P2.Cells(Rows.Count, 1).End(xlUp).Row
    lstP3 = P3.Cells(Rows.Count, 1).End(xlUp).Row
    lstP4 = P4.Cells(Rows.Count, 1).End(xlUp).Row
 
    creditRng = wsCredit.Range("A2:A" & lstRowCredit)
    Me.txtCredit.Value = Application.WorksheetFunction.Sum(creditRng)
 
    Me.txtBalance.Value = wsBalance.Range("A" & lstRowBalance).Value
 
    d1 = Application.WorksheetFunction.Sum(P1.Range("A" & lstP1))
    d2 = Application.WorksheetFunction.Sum(P2.Range("A" & lstP2))
    d3 = Application.WorksheetFunction.Sum(P3.Range("A" & lstP3))
    d4 = Application.WorksheetFunction.Sum(P4.Range("A" & lstP4))
 
    disbursal = d1 + d2 + d3 + d4
 
    Me.txtDisbursal.Value = disbursal
 
End Sub
Excel VBA Code (Module1):
Code: 
Sub DataEntry()
 
    UserForm1.Show
 
End Sub

Sub Reports()
 
    UserForm2.Show
 
End Sub
Data Entry:
Reports:

Thank you for reaching out. I have attached the solution Workbook with you. Please let me know if you have any further questions or if there's anything else I can assist you with.

Regards
Lutfor Rahman Shimanto
Click to expand...
Excel VBA Code (UserForm1):

Code: 
Private Sub CommandButton1_Click()
  
    Dim ws As Worksheet
    Dim wsCaseNo As Worksheet
    Dim wsDate As Worksheet
    Dim wsCredit As Worksheet
    Dim wsBalance As Worksheet
    Dim wsRemarks As Worksheet
    Dim lastRow, lastRowSummary As Long
  
    Set ws = ThisWorkbook.Sheets("Summary")
    Set wsCaseNo = ThisWorkbook.Sheets("Case No")
    Set wsDate = ThisWorkbook.Sheets("Date")
    Set wsCredit = ThisWorkbook.Sheets("Credit")
    Set wsBalance = ThisWorkbook.Sheets("Balance")
    Set wsRemarks = ThisWorkbook.Sheets("Remarks")
  
    lastRow = wsCaseNo.Cells(wsCaseNo.Rows.Count, 1).End(xlUp).Row + 1
    lastRowSummary = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row + 1
  
    wsCaseNo.Cells(lastRow, 1).Value = txtCaseNo.Value
    wsDate.Cells(lastRow, 1).Value = txtDate.Value
    wsCredit.Cells(lastRow, 1).Value = txtCredit.Value
    'wsBalance.Cells(lastRow, 1).Value = txtBalance.Value
    wsRemarks.Cells(lastRow, 1).Value = txtRemarks.Value
  
    With ws
        .Cells(lastRowSummary, 1).Value = txtCaseNo.Value
        .Cells(lastRowSummary, 2).Value = txtDate.Value
        .Cells(lastRowSummary, 6).Value = txtCredit.Value
        '.Cells(lastRowSummary, 11).Value = txtBalance.Value
        .Cells(lastRowSummary, 12).Value = txtRemarks.Value
    End With
  
    Call CalculateBalance
    ws.Cells(lastRowSummary, 11).Value = txtBalance.Value
    wsBalance.Cells(lastRow, 1).Value = txtBalance.Value
  
    If CInt(Me.txtBalance.Value) < 0 Then
  
        Call AddCredit
  
    End If
  
    Call SetDisbursalAmount
  
    Call ClearForm
  
    MsgBox "Data submitted successfully.", vbInformation

End Sub

Sub ClearForm()

    txtCaseNo.Value = ""
    txtDate.Value = ""
    txtCredit.Value = ""
    txtAmount.Value = ""
    txtBalance.Value = ""
    txtRemarks.Value = ""
    cmdDisbursalParty.Clear

End Sub

Private Sub txtAmount_Change()
  
    On Error Resume Next
    Me.txtBalance.Value = Me.txtCredit.Value - Me.txtAmount
  
'    If Me.txtBalance.Value < 0 Then
'        Call Me.CalculateBalance
'    End If
  
End Sub

'Private Sub txtBalance_Change()
'
'    If Right(Me.txtBalance.Value, 1) = "-" Then
'        Call CalculateBalance
'    End If
'
'End Sub

Private Sub txtCredit_Change()
  
    Dim summarySheet As Worksheet
    Dim lastRow As Integer
  
    Set summarySheet = ThisWorkbook.Sheets("Summary")
    lastRow = summarySheet.Cells(summarySheet.Rows.Count, 1).End(xlUp).Row
  
    If lastRow <= 2 Then
        Me.txtBalance.Value = Me.txtCredit.Value
    End If
  
    Me.txtBalance.Value = Me.txtCredit.Value
  
End Sub

Private Sub UserForm_Initialize()
  
    Dim summarySheet As Worksheet
    Dim valueRange As Range
    Dim valueArray As Variant
    Dim i, lastRow As Integer

    Set summarySheet = ThisWorkbook.Sheets("Summary")

    Set valueRange = summarySheet.Range("G2:J2")

    valueArray = valueRange.Value
    lastRow = summarySheet.Cells(summarySheet.Rows.Count, 1).End(xlUp).Row

    Me.cmdDisbursalParty.Clear

    For i = LBound(valueArray, 2) To UBound(valueArray, 2)
        Me.cmdDisbursalParty.AddItem valueArray(1, i)
    Next i
  
    If lastRow <= 2 Then
        Me.Label3.Caption = "Initial Credit"
        Me.txtCredit.Enabled = True
    Else
        Me.txtCredit.Enabled = False
        Me.txtCredit.Value = summarySheet.Range("K" & lastRow).Value
    End If

End Sub

Sub SetDisbursalAmount()
  
    Dim selectedValue As String
    Dim p1Sheet, p2Sheet, p3Sheet, p4Sheet, summary As Worksheet
    Dim lastRow, lastRowSummary As Long

    Set p1Sheet = ThisWorkbook.Sheets("Disbursal to P1")
    Set p2Sheet = ThisWorkbook.Sheets("Disbursal to P2")
    Set p3Sheet = ThisWorkbook.Sheets("Disbursal to P3")
    Set p4Sheet = ThisWorkbook.Sheets("Disbursal to P4")
    Set summary = ThisWorkbook.Sheets("Summary")

    selectedValue = Me.cmdDisbursalParty.Value
    lastRowSummary = summary.Cells(summary.Rows.Count, 1).End(xlUp).Row

    If selectedValue = "P1" Then
        lastRow = p1Sheet.Cells(p1Sheet.Rows.Count, 1).End(xlUp).Row + 1
        p1Sheet.Cells(lastRow, 1).Value = Me.txtAmount.Value
        summary.Cells(lastRowSummary, 7).Value = Me.txtAmount.Value
    ElseIf selectedValue = "P2" Then
        lastRow = p2Sheet.Cells(p2Sheet.Rows.Count, 1).End(xlUp).Row + 1
        p2Sheet.Cells(lastRow, 1).Value = Me.txtAmount.Value
        summary.Cells(lastRowSummary, 8).Value = Me.txtAmount.Value
    ElseIf selectedValue = "P3" Then
        lastRow = p3Sheet.Cells(p3Sheet.Rows.Count, 1).End(xlUp).Row + 1
        p3Sheet.Cells(lastRow, 1).Value = Me.txtAmount.Value
        summary.Cells(lastRowSummary, 9).Value = Me.txtAmount.Value
    ElseIf selectedValue = "P4" Then
        lastRow = p4Sheet.Cells(p4Sheet.Rows.Count, 1).End(xlUp).Row + 1
        p4Sheet.Cells(lastRow, 1).Value = Me.txtAmount.Value
        summary.Cells(lastRowSummary, 10).Value = Me.txtAmount.Value
    End If
  
End Sub

Sub CalculateBalance()
  
    Dim lastRow As Long
    Dim ws As Worksheet
    Dim i As Long
    Dim sumP As Double
  
    Set ws = ThisWorkbook.Sheets("Summary")
    lastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
  
    sumP = ws.Cells(lastRow, 7).Value + ws.Cells(lastRow, 8).Value + ws.Cells(lastRow, 9).Value + ws.Cells(lastRow, 10).Value
  
'    If (ws.Cells(lastRow, 6).Value - sumP) < 0 Then
'
'        MsgBox "Add Credit!", vbInformation
'        Call AddCredit
'        Exit Sub
'
'    End If
  
    ws.Cells(lastRow, 11).Value = ws.Cells(lastRow, 6).Value - sumP
    'ws.Cells(lastRow + 1, 6).Value = ws.Cells(lastRow, 11).Value
      
End Sub
Sub AddCredit()
  
    Dim ws, wsCredit, wsBalance As Worksheet
    Dim lastRow, lastRowCredit, lastRowBalance As Long
    Dim inputValue As Long
    Dim currentValue As Long
    Dim temp As Long
  
    Set ws = ThisWorkbook.Sheets("Summary")
    Set wsCredit = ThisWorkbook.Sheets("Credit")
    Set wsBalance = ThisWorkbook.Sheets("Balance")
    lastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
    lastRowCredit = wsCredit.Cells(Rows.Count, 1).End(xlUp).Row
    lastRowBalance = wsBalance.Cells(Rows.Count, 1).End(xlUp).Row
    currentValue = ws.Range("F" & lastRow).Value
  
    inputValue = InputBox("Enter a value:")
  
    If Not IsNumeric(inputValue) Then
        MsgBox "Invalid input. Please enter a numeric value.", vbExclamation
        Exit Sub
    End If
  
    ws.Range("F" & lastRow).Value = currentValue + inputValue
    temp = ws.Range("K" & lastRow).Value
    ws.Range("K" & lastRow).Value = ws.Range("K" & lastRow).Value + inputValue
    wsCredit.Range("A" & lastRowCredit + 1).Value = inputValue
    wsBalance.Range("A" & lastRowBalance + 1).Value = temp + inputValue

End Sub

Regards
 

Attachments

  • Marudhu1973.xlsm
    60.8 KB · Views: 0
Last edited:
You must log in or register to reply here.

Online statistics

Members online
0
Guests online
6
Total visitors
6
Totals may include hidden visitors.

Forum statistics

Threads
306
Messages
1,351
Members
557
Latest member
RSntg

Share this page

Top