Sunday, April 26, 2020

Create Rent A Car Agreement Form Excel VBA

Create Rent A Car Agreement Form Excel VBA

Welcome razakmcr Excel Tutorial 
In this Tutorial I Created Rent A car Agreement form 
 Name Address Contact And departure date arrival date and count day and extra hours rent amount   And Grand Total  Automatically  
I thing this will useful information  if Any wrong Any doubt please  Inform me 
Thank you   Also Watch Video Below And VBA Code
आपका स्वागत है razakmcr एक्सेल ट्यूटोरियल
इस ट्यूटोरियल में मैंने रेंट ए कार एग्रीमेंट फॉर्म तैयकिया नाम पता संपर्क और प्रस्थान की तारीख आगमन कतऔरदिन और अतिरिक्त घंटे किराया राशि और ग्रैंड कुल स्वचालित रूप से गिनें
मुझे लगता है कि यह उपयोगी जानकारी होगी यदि कोई भी गलत हो तो कृपया मुझे सूचित करें

धन्यवाद इसके अलावा नीचे वीडियो देखें और VBA कोड

Create Rent A Car Agreement Form Excel VBA

Watch Video



Check VBA Code

This Code For Ageement Number Project And Departure Date  Departure Time Arrival Date And Time


Private Sub UserForm_Initialize()
Dim RNG As Long
RNG = Sheet4.Range("A1000000").End(xlUp).Row + 1
Me.AGR1 = RNG + 11000
Me.Date1 = Date 'Dedparture Date
Me.Time1 = Format(Time, "HH:MM AM/PM") 'Departure Time
Me.Date2 = Date 'Arrival Date
Me.Time2 = Format(Time, "HH:MM AM/PM") 'Arrival Time
End Sub

This Code For Textbox Textformat To properCase
Private Sub TB4_Change()
On Error Resume Next      'Textbox ProperCase
Me.TB4 = Format(StrConv(Me.TB4, vbProperCase))
End Sub
Private Sub TB5_Change()
On Error Resume Next     'Textbox ProperCase
Me.TB5 = Format(StrConv(Me.TB5, vbUpperCase))
End Sub
Private Sub TB8_Change()
On Error Resume Next      'Textbox ProperCase
Me.TB8 = Format(StrConv(Me.TB8, vbProperCase))
End Sub

This Code For (CommandButtton) Frame Enable for Cteate agreement  Fill combobox 
Private Sub DeptCMD_Click() 'Commandbutton
Dim i As Long
'For Departure
Me.DeptFrame.Enabled = True
Me.ComboBox1.Clear
For i = 2 To Sheet2.Range("A100000").End(xlUp).Row
Me.ComboBox1.AddItem Sheet2.Cells(i, "A") 'Fill Vehicle Number
Me.ComboBox1.List(Me.ComboBox1.ListCount - 1, 1) = Sheet2.Cells(i, "B") 'Vehicle Name
Next i
Me.TB1.SetFocus
End Sub

This Code For (CommandButtton) Frame Enable for Cteate agreement  Fill combobox 
Private Sub ArrCMD_Click() 'Commandbutton
On Error Resume Next
Me.ArrFrame.Enabled = True
Me.ArrDate = Date
Me.ARRTime = Format(Time, "HH:MM AM/PM")
Me.TB13 = CDate(Me.ArrDate) - CDate(Me.DPTDate) 'In Date-Out Date
Me.TB16 = Format(Abs(TimeValue(Me.ARRTime) - TimeValue(Me.DPTTime)) * 24, "##") 'Intime - Out Time
Dim RNG1 As Long, i As Long
'Search Data to Arrival Form Matching By Agreement Number
RNG1 = Sheet4.Range("A1000000").End(xlUp).Row + 1
For i = 2 To RNG1        '(Agreement No)
If Sheet4.Cells(i, "D") = Val(Me.AGR2) Then
With Sheet4
Me.AGR1.Value = .Range("D" & i)              'Sheet4Column(D)
Me.TB1 = .Range("E" & i)                       'Renter Name
Me.TB2 = .Range("F" & i)                       'Cntact
Me.IDBox = .Range("G" & i)                    'Idbox
Me.TB3 = .Range("H" & i)                       'PP No
Me.TB4 = .Range("i" & i)                       'Driver Name
Me.TB5 = .Range("j" & i)                        'Nationality
Me.TB6 = .Range("K" & i)                       'Contact
Me.TB7 = .Range("L" & i)                      'Driving License No
Me.TB8 = .Range("M" & i)                      'Place If Issue
Me.TB9 = .Range("N" & i)                        'Expiry date
Me.ComboBox1 = .Range("O" & i)                 'Expiry date
Me.TB12 = .Range("P" & i)                      'Vehicle Name
Me.DPTDate = .Range("Q" & i)
Me.TB13 = CDate(Me.ArrDate) - CDate(Me.DPTDate)    'Calculate Days
Me.DPTTime = Format(.Range("R" & i), "HH:MM AM/PM") 'Time
Me.Date1 = .Range("Q" & i)
Me.Time1 = Format(.Range("R" & i), "HH:MM AM/PM")
Me.TB16 = Format(Abs(TimeValue(Me.ARRTime) - TimeValue(Me.DPTTime)) * 24, "##") 'calculate Time
Me.TB14 = .Range("V" & i)                      'Rent per Day
Me.TB17 = .Range("X" & i)                      'Extran Charge
Me.TB18 = .Range("Y" & i)                      'Traffic fine
Me.TB19 = .Range("Z" & i)                      'parking fine
Me.TB11 = .Range("V" & i)                      'Rent per Day
Me.TB21 = .Range("AC" & i).Value
Me.TB23 = .Range("AE" & i)                     'Status
End With
End If
Next i
Call TB13_Change
End Sub
This Code For Textbox Format
Private Sub ArrDate_AfterUpdate()
On Error Resume Next
Me.ArrDate = CDate(Me.ArrDate)
End Sub
Private Sub ComboBox1_Click()
Me.TB12 = Me.ComboBox1.List(Me.ComboBox1.ListIndex, 1) 'Vehicle Name
End Sub
This Code For (CommandButtton) Frame Enable And Arrival vehicle Checkout

Private Sub ArrCMD_Click() 'Commandbutton
On Error Resume Next
Me.ArrFrame.Enabled = True
Me.ArrDate = Date
Me.ARRTime = Format(Time, "HH:MM AM/PM")
Me.TB13 = CDate(Me.ArrDate) - CDate(Me.DPTDate) 'In Date-Out Date
Me.TB16 = Format(Abs(TimeValue(Me.ARRTime) - TimeValue(Me.DPTTime)) * 24, "##") 'Intime - Out Time
Dim RNG1 As Long, i As Long
'Search Data to Arrival Form Matching By Agreement Number
RNG1 = Sheet4.Range("A1000000").End(xlUp).Row + 1
For i = 2 To RNG1        '(Agreement No)
If Sheet4.Cells(i, "D") = Val(Me.AGR2) Then
With Sheet4
Me.AGR1.Value = .Range("D" & i)              'Sheet4Column(D)
Me.TB1 = .Range("E" & i)                       'Renter Name
Me.TB2 = .Range("F" & i)                       'Cntact
Me.IDBox = .Range("G" & i)                    'Idbox
Me.TB3 = .Range("H" & i)                       'PP No
Me.TB4 = .Range("i" & i)                       'Driver Name
Me.TB5 = .Range("j" & i)                        'Nationality
Me.TB6 = .Range("K" & i)                       'Contact
Me.TB7 = .Range("L" & i)                      'Driving License No
Me.TB8 = .Range("M" & i)                      'Place If Issue
Me.TB9 = .Range("N" & i)                        'Expiry date
Me.ComboBox1 = .Range("O" & i)                 'Expiry date
Me.TB12 = .Range("P" & i)                      'Vehicle Name
Me.DPTDate = .Range("Q" & i)
Me.TB13 = CDate(Me.ArrDate) - CDate(Me.DPTDate)    'Calculate Days
Me.DPTTime = Format(.Range("R" & i), "HH:MM AM/PM") 'Time
Me.Date1 = .Range("Q" & i)
Me.Time1 = Format(.Range("R" & i), "HH:MM AM/PM")
Me.TB16 = Format(Abs(TimeValue(Me.ARRTime) - TimeValue(Me.DPTTime)) * 24, "##") 'calculate Time
Me.TB14 = .Range("V" & i)                      'Rent per Day
Me.TB17 = .Range("X" & i)                      'Extran Charge
Me.TB18 = .Range("Y" & i)                      'Traffic fine
Me.TB19 = .Range("Z" & i)                      'parking fine
Me.TB11 = .Range("V" & i)                      'Rent per Day
Me.TB21 = .Range("AC" & i).Value
Me.TB23 = .Range("AE" & i)                     'Status
End With
End If
Next i
Call TB13_Change
End Sub
Private Sub ArrDate_AfterUpdate()
On Error Resume Next
Me.ArrDate = CDate(Me.ArrDate)
End Sub
Private Sub ComboBox1_Click()
Me.TB12 = Me.ComboBox1.List(Me.ComboBox1.ListIndex, 1) 'Vehicle Name
End Sub

This Code For CommandButtton Ebable And Desable And Statusbar(Textbox) Text project
Private Sub TB23_Change()
On Error Resume Next
If Me.TB23 = "Arrived" Then
Me.TB23.ForeColor = &H8000&      'Stauts Bar Display On Departure Or Arrived
Me.CommandButton4.Enabled = False
Else
Me.TB23.ForeColor = vbRed
Me.CommandButton4.Enabled = True
End If
On Error Resume Next
If Val(Me.TB22) >= 1 Then
Me.CommandButton4.Enabled = True
Me.TB22.ForeColor = vbRed  'Balance Amount
End If
End Sub

This Code For Textbox Format And  Divide And Sum And Multiple Amount
Private Sub TB1_Change()
On Error Resume Next
Me.TB1 = Format(StrConv(Me.TB1, vbProperCase))
End Sub
Private Sub TB10_Change()
On Error Resume Next
Me.TB10 = Format(StrConv(Me.TB1, vbProperCase))
End Sub
Private Sub TB13_Change()
On Error Resume Next
Me.TB15 = Format(Val(Me.TB13) * Val(Me.TB14), "#####.00")
Call TB16_Change
Call TB15_Change
End Sub
Private Sub TB14_Change()
On Error Resume Next
Call TB13_Change
End Sub
Private Sub TB15_Change()
On Error Resume Next
'Rent Calculater(rent Amount) +(ExtraCharge) +(Trafiic fine)+(Parking fine)
Me.TB20 = Format(Val(Me.TB15) + Val(Me.TB17) + Val(Me.TB18) + Val(Me.TB19), "#####.00")
Call TB21_Change
End Sub
Private Sub TB16_Change()
On Error Resume Next
A = Val(Me.TB14) / 24  'RentAmount/24 hour
Me.TB17 = Format(Val(Me.TB16) * A, "#####.00") 'Amount* hours
Call TB15_Change
End Sub

This Code For Textbox Format And Call Micro
Private Sub TB17_Change()
On Error Resume Next
Call TB15_Change
End Sub
Private Sub TB18_AfterUpdate()
On Error Resume Next
Me.TB18 = Format(Me.TB18, "#####.00") 'Number format
End Sub
Private Sub TB18_Change()
Call TB15_Change
End Sub
Private Sub TB19_AfterUpdate()
On Error Resume Next
Me.TB19 = Format(Me.TB19, "#####.00") 'Number format
End Sub
Private Sub TB19_Change()
Call TB15_Change
End Sub
Private Sub TB21_Change()
On Error Resume Next
                '(Pay Amount) - (Paid Amount)
Me.TB22 = Format(Val(Me.TB20) - Val(Me.TB21), "#####.00") 'Number format
Private Sub TB1_Change()
This Code For Option Button Choose Pass/Id/Other
Private Sub OptionButton1_Click()
Me.IDBox = "Passport"
Me.TBRange.Value = "C"
Me.TB3.SetFocus
End Sub
Private Sub OptionButton2_Click()
Me.IDBox = "ID Card"
Me.TBRange = "D"
Me.TB3.SetFocus
End Sub
Private Sub OptionButton3_Click()
Me.IDBox = "Other"
Me.TBRange = "E"
Me.TB3.SetFocus
End Sub
This Code For Textbox If function For Sheet4(Databse) Column Address C D E
Private Sub DPTDate_AfterUpdate()
On Error Resume Next
Me.DPTDate = CDate(Me.DPTDate)
End Sub
Private Sub IDBox_Change()
If Me.IDBox = "Passport" Then
Me.TBRange = "C"
ElseIf Me.IDBox = "ID Card" Then
Me.TBRange = "D"
Else
Me.TBRange = "E"
End If
End Sub

This Code For Transfer Data to Sheet4(Database) Departure Data And CallCMD2 And CMD5
Private Sub CommandButton1_Click()
Dim RNG1 As Long
'Save To database(sheet4)
RNG1 = Sheet4.Range("A1000000").End(xlUp).Row + 1
With Sheet4
.Range("A" & RNG1) = RNG1 + 100
.Range("B" & RNG1) = Me.Date1
.Range("C" & RNG1) = Format(Time, "HH:MM AM/PM")
.Range("D" & RNG1) = Me.AGR1.Value
.Range("E" & RNG1) = Me.TB1                        'Renter Name
.Range("F" & RNG1) = Me.TB2                        'Cntact
.Range("G" & RNG1) = Me.IDBox                      'Idbox
.Range("H" & RNG1) = Me.TB3                        'PP No
.Range("i" & RNG1) = Me.TB4                        'Driver Name
.Range("j" & RNG1) = Me.TB5                        'Nationality
.Range("K" & RNG1) = Me.TB6                        'Contact
.Range("L" & RNG1) = Me.TB7                        'Driving License No
.Range("M" & RNG1) = Me.TB8                        'Place If Issue
.Range("N" & RNG1) = Me.TB9                        'Expiry date
.Range("O" & RNG1) = Me.ComboBox1                  'Expiry date
.Range("P" & RNG1) = Me.TB12                       'Vehicle Name
.Range("Q" & RNG1) = Date                          'DPT date
.Range("R" & RNG1) = Format(Time, "HH:MM AM/PM")   'DPT Time
.Range("V" & RNG1) = Me.TB11                       'Rent per Day
.Range("AE" & RNG1) = "On Departure"                       'Rent per Day
End With
Call CommandButton2_Click   'Clear Sheet3 Invoice Sheet And fill
If MsgBox("You want print agreement?", vbYesNo) = vbYes Then
Call CommandButton5_Click  'PrintOut
 End If
End Sub
This Code For Clear Data To Sheet3(Invoice) And Yransfer Data To sheet3 (Invoice)
Private Sub CommandButton2_Click()
With Sheet3
'Clear Invoice (Sheet3)
.Range("E" & 4) = ""
.Range("C" & 5) = ""
.Range("B" & 7) = ""
.Range("D" & 9) = ""                         'Renter Name
.Range("D" & 10) = ""
.Range("C" & 12) = ""
.Range("D" & 12) = ""
.Range("E" & 12) = ""
.Range("D" & 13) = ""                        'Driver Name
.Range("D" & 14) = ""                        'Nationality
.Range("D" & 15) = ""                        'Contact
.Range("D" & 16) = ""                        'Driving License No
.Range("D" & 17) = ""                        'Place If Issue
.Range("D" & 18) = ""                        'Expiry date
.Range("C" & 20) = ""                        'Dep Date
.Range("E" & 20) = ""                        'Dpt Time
.Range("C" & 22) = ""
.Range("E" & 22) = ""
.Range("E" & 23) = ""                        'Expiry date
.Range("E" & 24) = ""                        'Vehicle Name
.Range("E" & 25) = ""
.Range("E" & 26) = ""
.Range("E" & 27) = ""
.Range("E" & 28) = ""
.Range("E" & 29) = ""
.Range("E" & 30) = ""
.Range("E" & 31) = ""
'Fill invoice (sheet3)
.Range("E" & 4) = Me.Date1
.Range("C" & 5) = Format(Me.Time1, "HH:MM AM/PM")
.Range("B" & 7) = Me.AGR1.Value                 'Agreement No
'.Range("E" & 7) = Me.AGR1.Value                 'Agreement No
.Range("D" & 9) = Me.TB1                        'Renter Name
.Range("D" & 10) = Me.TB2                        'Cntact
Dim RN As String
RN = Me.TBRange  'Range
.Range(RN & 12) = Me.TB3                         'Id No,Passport No,Other
.Range("D" & 13) = Me.TB4                        'Driver Name
.Range("D" & 14) = Me.TB5                        'Nationality
.Range("D" & 15) = Me.TB6                        'Contact
.Range("D" & 16) = Me.TB7                        'Driving License No
.Range("D" & 17) = Me.TB8                        'Place If Issue
.Range("D" & 18) = Me.TB9                        'Expiry date
.Range("C" & 20) = Me.Date1                      'Dep Date
.Range("E" & 20) = Format(Me.Time1, "HH:MM AM/PM")   'Dpt Time
.Range("E" & 23) = Me.ComboBox1                  'Expiry date
.Range("E" & 24) = Me.TB12                       'Vehicle Name
.Range("E" & 25) = Format(Me.TB11.Value, "#####.00")   'Rent per Day
End With
End Sub

This Code For Clear Transfer Arrival Data To sheet4 And Call CMD2 And CMD5
Private Sub CommandButton3_Click()
Unload Me
UserForm2.Show
End Sub
Private Sub CommandButton4_Click()
Dim RNG1, X As Long
'Fill To Database(sheet4) arrival data
RNG1 = Sheet4.Range("A1000000").End(xlUp).Row + 1
For X = 2 To RNG1
If Sheet4.Cells(X, "D") = Val(Me.AGR2) Then
With Sheet4
.Range("S" & X) = Me.ArrDate          'Arrival Date
.Range("T" & X) = Me.ARRTime          'Arrival Time
.Range("U" & X) = Me.TB13.Value       'Total Day
.Range("W" & X) = Me.TB15.Value       'Total rent Amount
.Range("X" & X) = Me.TB17.Value       'Extra Amount
.Range("Y" & X) = Me.TB18.Value       'Traffic fine
.Range("Z" & X) = Me.TB19.Value       'Parking fine
.Range("AB" & X) = Me.TB20.Value      'Total Amount
.Range("AC" & X) = Me.TB21.Value      'Paid Amount
.Range("AD" & X) = Me.TB22.Value      'Balance Amount
.Range("AE" & X) = "Arrived"          'Status
End With
End If
Next X
Call CommandButton2_Click  'for Printsheet(sheet3) Clear And fill departure Data
'fill Printsheet(sheet3)Arrival data
Sheet3.Range("C22") = Me.ArrDate
Sheet3.Range("E22") = Me.ARRTime
Sheet3.Range("E26") = Me.TB13.Value
Sheet3.Range("E27") = Me.TB15.Value
Sheet3.Range("E28") = Me.TB17.Value
Sheet3.Range("E29") = Me.TB18.Value
Sheet3.Range("E30") = Me.TB19.Value
Sheet3.Range("E31") = Me.TB20.Value
If MsgBox("You want print agreement?", vbYesNo) = vbYes Then
Call CommandButton5_Click   'for printout
 End If
Unload Me
UserForm2.Show
End Sub
Private Sub CommandButton5_Click()
'Printout
Application.ScreenUpdating = False
With Sheet3
.Range("B2:E39").PrintOut
.PageSetup.Orientation = xlPortrait
.PageSetup.PaperSize = xlPaperA4
End With
Application.ScreenUpdating = True
End Sub

Thursday, April 16, 2020

Create Income Expense Form In Excel VBA

Down Load Android App  

Income Expense   







VBA code
Ledger Form
Me.ComboBox1.DropDown
End Sub
Private Sub CommandButton1_Click()
Dim MROW As Long
If Me.TextBox1 <> "" And Me.TextBox1 <> "" Then
MROW = Sheet3.Range("A1000000").End(xlUp).Row + 1
Sheet3.Range("A" & MROW) = Me.TextBox1
Sheet3.Range("B" & MROW) = Me.ComboBox1
Me.TextBox1 = ""
Me.ComboBox1 = ""
Me.TextBox1.SetFocus
Else
MsgBox "Please Fill name And Group"
End If
End Sub
Private Sub TextBox1_AfterUpdate()
On Error Resume Next
A = Application.WorksheetFunction.Match(Me.TextBox1, Sheet3.Range("A:A"), 0)
If A >= 1 Then
MsgBox "This Name already exist"
Me.TextBox1 = ""
End If
Me.TextBox1.SetFocus
End Sub
Private Sub TextBox1_Change()
On Error Resume Next
Me.TextBox1 = Format(StrConv(Me.TextBox1, vbProperCase))
End Sub
Private Sub UserForm_Initialize()
Me.ComboBox1.List = Array("Income", "Expense")
End Sub
TransForm
Private Sub CashMB_Enter()
Me.CashMB.DropDown
End Sub
Private Sub CommandButton1_Click()
Dim MROW As Long
Dim CLN As String
'Input Data
If Me.LedgerCMB = "" And Me.AmtBox = "" Then
MsgBox "Please input amount And name "
Me.GroupCMB.SetFocus
Exit Sub
Else
CLN = Me.CLNBOX 'Textbox for Column Address
MROW = Sheet2.Range("A1000000").End(xlUp).Row + 1
Sheet2.Range("A" & MROW) = Format(CDate(Me.TextBox1), "DD/MMM/YYYY")
Sheet2.Range("B" & MROW) = Me.LedgerCMB
Sheet2.Range("C" & MROW) = Me.GroupCMB
Sheet2.Range(CLN & MROW) = Me.AmtBox.Value
Sheet2.Range("F" & MROW) = Me.CashMB
Sheet2.Range("G" & MROW) = MROW + 100
'Form Clear
Me.GroupCMB = ""
Me.LedgerCMB = ""
Me.AmtBox = ""
Me.CashMB = ""
Me.CLNBOX = ""
Me.TextBox1.SetFocus
End If
End Sub
Private Sub GroupCMB_Change()
Dim I As Long
Me.LedgerCMB.Clear
For I = 2 To Sheet3.Range("A1000000").End(xlUp).Row
If Sheet3.Cells(I, "B") = Me.GroupCMB Then
Me.LedgerCMB.AddItem Sheet3.Cells(I, "A")
End If
Next I
If Me.GroupCMB = "Income" Then
Me.CLNBOX = "D"
ElseIf Me.GroupCMB = "Expense" Then
Me.CLNBOX = "E"
End If
End Sub
Private Sub GroupCMB_Enter()
Me.GroupCMB.DropDown
End Sub
Private Sub LedgerCMB_Enter()
Me.LedgerCMB.DropDown
End Sub
Private Sub TextBox1_AfterUpdate()
On Error Resume Next
Me.TextBox1 = CDate(Me.TextBox1)
End Sub
Private Sub TextBox1_Enter()
Me.TextBox1.SelStart = (0)
Me.TextBox1.SelLength = Len(Me.TextBox1)
End Sub
Private Sub UserForm_Initialize()
Me.GroupCMB.List = Array("Income", "Expense")  'Combobox
Me.CashMB.List = Array("Cash", "Bank")         'Combobox
Me.TextBox1 = Date
End Sub

HomeForm

Private Sub CommandButton1_Click()
TransForm.Show
End Sub
Private Sub CommandButton5_Click()
With Me.ListBox1
.Clear
.AddItem "Income"
.List(.ListCount - 1, 1) = "Cash"
.List(.ListCount - 1, 2) = "Bank"
.List(.ListCount - 1, 3) = "Expense"
.List(.ListCount - 1, 4) = "Cash"
.List(.ListCount - 1, 5) = "Bank"
.Selected(0) = True
'Income Fill
Dim I As Long
Dim RNG As Long
RNG = Sheet3.Range("A1000000").End(xlUp).Row + 1
For I = 2 To RNG
If Sheet3.Cells(I, "B") = "Income" Then
.AddItem Sheet3.Cells(I, "A")
End If
Next I
'Expense Fill
For X = 1 To RNG
If Sheet3.Cells(X, "B") = "Expense" Then
.AddItem
M = M + 1
.List(M, 3) = Sheet3.Cells(X, "A")
End If
Next X
'Title Down
.AddItem
.List(.ListCount - 2, 0) = "Income"
.List(.ListCount - 2, 1) = "Cash"
.List(.ListCount - 2, 2) = "Bank"
.List(.ListCount - 2, 3) = "Expense"
.List(.ListCount - 2, 4) = "Cash"
.List(.ListCount - 2, 5) = "Bank"
'UnderLine
.AddItem
For b = 0 To 5
.List(.ListCount - 2, b) = "------------------------"
Next b
'Date
Dim EDate, ENDate As Date
'Start Date
EDate = CDate(Application.WorksheetFunction.EoMonth(1 & "/" & Me.MonthCMB & "/" & Me.YearCMB, -1) + 1)
'End Date
ENDate = CDate(Application.WorksheetFunction.EoMonth(1 & "/" & Me.MonthCMB & "/" & Me.YearCMB, 0))
Dim RNG2 As Long
Dim sum, sum1, sum4, sum5 As Double
Dim C, C1, C2, C3 As Integer
Dim A, A1, A2, A3 As Long
RNG2 = Sheet2.Range("A1000000").End(xlUp).Row + 1
For C = 1 To .ListCount - 1
For A = 1 To RNG2
'Sum from Sheet2
'Cash Income Total
If .List(C, 0) = Sheet2.Cells(A, "B") And Sheet2.Cells(A, "A") >= _
EDate And Sheet2.Cells(A, "A") <= ENDate And Sheet2.Cells(A, "F") = "Cash" Then
sum = sum + Val(Sheet2.Cells(A, "D"))
.List(C, 1) = Format(sum, "#####.00")
End If
Next A
sum = 0
Next C
'Sum from Sheet2
'Bank Bank Income Total
For C1 = 1 To .ListCount - 1
For A1 = 1 To RNG2
If .List(C1, 0) = Sheet2.Cells(A1, "B") And Sheet2.Cells(A1, "A") >= _
EDate And Sheet2.Cells(A1, "A") <= ENDate And Sheet2.Cells(A1, "F") = "Bank" Then
sum4 = sum4 + Val(Sheet2.Cells(A1, "D"))
.List(C1, 2) = Format(sum4, "#####.00")
End If
Next A1
sum4 = 0
Next C1
'Sum from Sheet2
'Expens Cash Total
For C2 = 1 To .ListCount - 1
For A2 = 1 To RNG2
If .List(C2, 3) = Sheet2.Cells(A2, "B") And Sheet2.Cells(A2, "A") >= _
EDate And Sheet2.Cells(A2, "A") <= ENDate And Sheet2.Cells(A2, "F") = "Cash" Then
sum1 = sum1 + Val(Sheet2.Cells(A2, "E"))
.List(C2, 4) = Format(sum1, "#####.00")
End If
Next A2
sum1 = 0
Next C2
'Sum from Sheet2
'Expense Bank Total
For C3 = 1 To .ListCount - 1
For A3 = 1 To RNG2
If .List(C3, 3) = Sheet2.Cells(A3, "B") And Sheet2.Cells(A3, "A") >= _
EDate And Sheet2.Cells(A3, "A") <= ENDate And Sheet2.Cells(A3, "F") = "Bank" Then
sum5 = sum5 + Val(Sheet2.Cells(A3, "E"))
.List(C3, 5) = Format(sum5, "#####.00")
End If
Next A3
sum5 = 0
Next C3
'Sum from Listbox
Dim N As Integer
Dim Sum2, sum3, sum6, sum7 As Double
For N = 1 To .ListCount - 1
On Error Resume Next
Sum2 = Sum2 + Val(.List(N, 1)) 'Income Cash
sum3 = sum3 + Val(.List(N, 4)) 'Expense Cash
sum6 = sum6 + Val(.List(N, 2)) 'Income Bank
sum7 = sum7 + Val(.List(N, 5)) 'Expense Bank
Next N
'Sum Total year
Dim YrIncSum, YrExpSum As Double
Dim STR, EDT As Date
STR = 1 & "/" & "January" & "/" & Me.YearCMB
EDT = 31 & "/" & "December" & "/" & Me.YearCMB
'sum Income Year
YrIncSum = Application.WorksheetFunction.SumIfs(Sheet2.Range("D:D"), Sheet2.Range("A:A"), ">=" & _
STR, Sheet2.Range("A:A"), "<=" & EDT)
'Sum Espense Year
YrExpSum = Application.WorksheetFunction.SumIfs(Sheet2.Range("E:E"), Sheet2.Range("A:A"), ">=" & _
STR, Sheet2.Range("A:A"), "<=" & EDT)
'Income
.AddItem
.List(.ListCount - 2, 0) = "Total Income"               'Text column 0
.List(.ListCount - 2, 1) = Format(Sum2, "####.00")      'Cash Income column1
.List(.ListCount - 2, 2) = Format(sum6, "####.00")      'Bank Income  column2
'Expense
.List(.ListCount - 2, 3) = "Total Expense"               'Text column3
.List(.ListCount - 2, 4) = Format(sum3, "#####.00")      ' Cash Expense column4
.List(.ListCount - 2, 5) = Format(sum7, "####.00")       ' Bank Expense column5
'Grand Total Selected month
.AddItem
.List(.ListCount - 2, 0) = Me.MonthCMB                    'combobox(month)
.List(.ListCount - 2, 1) = "Grand Total "
.List(.ListCount - 2, 2) = Format(Sum2 + sum6, "####.00") 'Income Cash+Income Bank
.List(.ListCount - 2, 3) = Me.MonthCMB                    'Combobox(Year)
.List(.ListCount - 2, 4) = "Grand Total  "
.List(.ListCount - 2, 5) = Format(sum3 + sum7, "####.00")  'Expense Cash + Expense Bank
'Undedrline
.AddItem "_________________"
.List(.ListCount - 2, 0) = "_________________"
.List(.ListCount - 2, 1) = "_________________"
.List(.ListCount - 2, 2) = "_________________"
.List(.ListCount - 2, 3) = "_________________"
.List(.ListCount - 2, 4) = "_________________"
.List(.ListCount - 2, 5) = "_________________"
'Month Balance
.AddItem
.List(.ListCount - 2, 0) = Me.MonthCMB & " Cash In Hand"
.List(.ListCount - 2, 1) = Format(Val(Sum2 - sum3), "#####.00")  'Income Cash - Expense Cash
.List(.ListCount - 2, 2) = "Year"
.List(.ListCount - 2, 3) = "Income"
.List(.ListCount - 2, 4) = Format(YrIncSum, "#####.00")          'Year Income Total
'Year Balance Income-Expense
.AddItem
.List(.ListCount - 2, 0) = Me.MonthCMB & " In Bank"
.List(.ListCount - 2, 1) = Format(Val(sum6 - sum7), "#####.00")  'Income Bank - Expense bank
.List(.ListCount - 2, 2) = Me.YearCMB                            'Combobx Year
.List(.ListCount - 2, 3) = "Expense"
.List(.ListCount - 2, 4) = Format(YrExpSum, "#####.00")          'Year Total Expense
'Total Cash + Bank Month
BLN = Val(Sum2 - sum3) + Val(sum6 - sum7)
.AddItem
.List(.ListCount - 2, 0) = "Total"
.List(.ListCount - 2, 1) = Format(BLN, "#####.00")
.List(.ListCount - 2, 3) = "Balance"
.List(.ListCount - 2, 4) = Format(Val(YrIncSum - YrExpSum), "#####.00")
End With
End Sub
Private Sub CommandButton3_Click()
LedgersForm.Show
End Sub
Private Sub CommandButton4_Click()
Dim EDate, ENDate As Date
'Start Date
EDate = CDate(Application.WorksheetFunction.EoMonth(1 & "/" & _
Me.MonthCMB & "/" & Me.YearCMB, -1) + 1)
'End Date
ENDate = CDate(Application.WorksheetFunction.EoMonth(1 & "/" & _
Me.MonthCMB & "/" & Me.YearCMB, 0))
'Listbox Header
With Me.ListBox1
.Clear
.AddItem
For X = 0 To 6                      'Loop Column
.List(0, X) = Sheet2.Cells(1, X + 1)
Next X
.Selected(0) = True
'Listbox Fill
Dim I As Long
For I = 2 To Sheet2.Range("A1000000").End(xlUp).Row + 1
If Sheet2.Cells(I, "A") >= EDate And Sheet2.Cells(I, "A") <= ENDate Then
.AddItem
For C = 0 To 6       'Loop Column
.List(.ListCount - 1, C) = Sheet2.Cells(I, C + 1)
Next C
End If
Next I
'Sum Total
Dim R As Integer
Dim sum, sum1 As Double
For R = 1 To .ListCount - 1
sum = sum + Val(.List(R, 3))     'Amount In
sum1 = sum1 + Val(.List(R, 4))   'Amount out
Next R
'UnderLine
.AddItem
.List(.ListCount - 1, 3) = "----------------------"
.List(.ListCount - 1, 4) = "----------------------"
.List(.ListCount - 1, 5) = "----------------------"
On Error Resume Next
.AddItem
.List(.ListCount - 1, 3) = Format(sum, "#####.00")                          'Total Amount in
.List(.ListCount - 1, 4) = Format(sum1, "#####.00")                         'Total Amount Out
.List(.ListCount - 1, 5) = "Balance: " & Format(Val(sum - sum1), "#####.00") 'Balance
End With
End Sub
Private Sub UserForm_Initialize()
For I = 0 To 11
Me.YearCMB.AddItem Format(Date, "YYYY") - I
Me.MonthCMB.AddItem MonthName(I + 1)
Next I
Me.YearCMB = Format(Date, "YYYY")   'Combobox
Me.MonthCMB = Format(Date, "MMMM")  'Combobox
End Sub