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 कोड

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

Combobox Use Listindex print salary sheet Excel VBA

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