Click here to download this file
VBA CODE FOR ACCOUNT LEDGER
Option Explicit
'filter data and display in
listbox
Dim sh As Worksheet
Set sh = Sheets("sheet1")
Dim i, x
As Long
Me.ListBox1.Clear
' For Title
Me.ListBox1.AddItem "Date"
Me.ListBox1.List(0, 1) = "Transaction
Type"
Me.ListBox1.List(0, 2) = "Ref
No"
Me.ListBox1.List(0, 3) = "Debit
Amount"
Me.ListBox1.List(0, 4) = "Credit
Amount"
Me.ListBox1.List(0, 5) = "Staff
Name"
Me.ListBox1.Selected(0) = True
For i = 2 To sh.Range("B10000").End(xlUp).Row
If sh.Cells(i, 1) >= CDate(Me.TextBox1) And sh.Cells(i, 1) <= CDate(Me.TextBox2) _
And sh.Cells(i, 2) = Me.ComboBox1 And sh.Cells(i, 7) = Me.ComboBox2 Then
Me.ListBox1.AddItem sh.Cells(i, 1)
Me.ListBox1.List(ListBox1.ListCount - 1,
1) = sh.Cells(i, 3) 'transaction type
Me.ListBox1.List(ListBox1.ListCount - 1,
2) = sh.Cells(i, 4) 'ref no
Me.ListBox1.List(ListBox1.ListCount - 1,
3) = sh.Cells(i, 5) 'Debit
Me.ListBox1.List(ListBox1.ListCount - 1,
4) = sh.Cells(i, 6) 'Credit
Me.ListBox1.List(ListBox1.ListCount - 1, 5) = sh.Cells(i, 7) 'Staff
End If
Next i
Dim mysum, Dsum As Double
mysum = 0
With ListBox1
Dim r As Long
For r = 1 To .ListCount - 1
On Error Resume Next
mysum = mysum + .List(r, 3) 'sum for debit
Dsum = Dsum + .List(r, 4) 'sum for credit
Next r
End With
Me.TextBox3.Value = mysum
Me.TextBox4.Value = Dsum
Me.TextBox5.Value = mysum - Dsum
End
Sub
Private Sub CommandButton2_Click()
' Generate reports as new excel file
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Workbooks.Add
Dim csh As Worksheet
Dim x As Integer
Set csh =
ActiveWorkbook.Sheets("Sheet1")
csh.Range("A1") = "LEDGER FOR"
csh.Range("B1") = Me.ComboBox1.Value
csh.Range("B1:D1").MergeCells = True
Dim i As Long
For i = 0 To Me.ListBox1.ListCount - 1
csh.Range("A100000").End(xlUp).Offset(1,
0) = Me.ListBox1.List(i, 0) 'date
csh.Range("A100000").End(xlUp).Offset(0,
1) = Me.ListBox1.List(i, 1) ''transaction type
csh.Range("A100000").End(xlUp).Offset(0,
2) = Me.ListBox1.List(i, 2)
csh.Range("A100000").End(xlUp).Offset(0,
3) = Me.ListBox1.List(i, 3)
csh.Range("A100000").End(xlUp).Offset(0,
4) = Me.ListBox1.List(i, 4)
csh.Range("A100000").End(xlUp).Offset(0, 5) = Me.ListBox1.List(i, 5)
Next i
Dim r As Long
r = csh.Range("A10000").End(xlUp).Row +
2
csh.Cells(r, 4) = "=sum" &
"(D" & 3 & ":" & "D" & r - 1
& ")" 'formula for debit
total
csh.Cells(r, 5) = "=sum" &
"(E" & 3 & ":" & "E" & r - 1
& ")" 'formula for credit total
csh.Cells(r + 1, 3).Value = "BALANCE"
csh.Cells(r + 1, 4) = csh.Cells(r, 4) - csh.Cells(r, 5)
Cells.Select
Cells.EntireColumn.AutoFit
csh.SaveAs Me.ComboBox1.Value & " " & Date
Unload Me
End Sub
Private
Sub TextBox1_AfterUpdate()
Me.TextBox1 = CDate(Me.TextBox1)
End Sub
Me.TextBox2 = CDate(Me.TextBox2)
End Sub
Dim sh As
Worksheet
Set sh =
Sheets("sheet1")
Dim i As
Long
For i = 2 To
sh.Range("B10000").End(xlUp).Row
If Application.WorksheetFunction.CountIf(sh.Range("b2", "b" & i), sh.Cells(i, 2)) = 1 Then
Me.ComboBox1.AddItem sh.Cells(i, 2)
If
Application.WorksheetFunction.CountIf(sh.Range("G2", "G"
& i), sh.Cells(i, 7)) = 1 Then
Me.ComboBox2.AddItem
sh.Cells(i, 7)
End If
End If
Next i
End Sub
Sir, Nice Video
ReplyDeletePls. send me including update delete, next, previous, etc option if possible.
Thanks.
.
Please add one more item Balance Payment details
ReplyDeletePl send me latest file.
ReplyDeleteGood software bhai
ReplyDelete