Forum Discussion

andrea.marketer's avatar
andrea.marketer
Copper Contributor
Apr 14, 2018

VBA for Userform For Expenses

I have this Userform to make the data input easier. Picture 1.

After I adapt some vba code Then I run the userform then it goes to Data table. Picture 2.

 

My concern is to make the Userform more interface. 
I want, before I can submit the data, the total of item price shows, so the user may know how much the expenditure for an item. And I still dont know how to make it. 

 

It will be more appreciate if there anybody can make this code simple.

 

This is the vba code:

 

Dim currentrow As Long

Private Sub cmbType_Change()

End Sub

Private Sub cmdGetNext_Click()
Dim NameFound As Range
fPath = ThisWorkbook.Path & "\"
Range("A1").Select
ActiveCell.End(xlDown).Select
lastrow = ActiveCell.Row
currentrow = currentrow + 1
If currentrow = lastrow + 1 Then
currentrow = lastrow
MsgBox "you have reached the last row!"
End If

With Cells(currentrow, 1)
txtItem.Text = Cells(currentrow, 4).Value
Set NameFound = .Find(txtItem.Text)

With NameFound
On Error Resume Next
imgData.Picture = LoadPicture(fPath & "nopic.jpg")
imgData.Picture = LoadPicture(fPath & txtItem.Text & ".jpg")
End With
End With

txtItem.Text = Cells(currentrow, 4).Value
txtQty.Text = Cells(currentrow, 5).Value
txtPrice.Text = Cells(currentrow, 7).Value
End Sub

Private Sub cmdGetPrev_Click()
Dim NameFound As Range
fPath = ThisWorkbook.Path & "\"
currentrow = currentrow - 1
If currentrow > 1 Then
txtItem.Text = Cells(currentrow, 4).Value
txtQty.Text = Cells(currentrow, 5).Value
txtPrice.Text = Cells(currentrow, 7).Value

With Cells(currentrow, 1)
txtItem.Text = Cells(currentrow, 4).Value
Set NameFound = .Find(txtItem.Text)

With NameFound
On Error Resume Next
imgData.Picture = LoadPicture(fPath & "nopic.jpg")
imgData.Picture = LoadPicture(fPath & txtItem.Text & ".jpg")
End With
End With

ElseIf currentrow = 1 Then
MsgBox "This is your first record!"
currentrow = currentrow + 1
End If

End Sub

Private Sub cmdSubmit_Click()
Range("A1").Select
ActiveCell.End(xlDown).Select
lastrow = ActiveCell.Row
'MsgBox lastrow
Cells(lastrow + 1, 1).Value = cmbDate.Text
Cells(lastrow + 1, 2).Value = cmbMonth.Text
Cells(lastrow + 1, 3).Value = cmbYears.Text
Cells(lastrow + 1, 4).Value = txtItem.Text
Cells(lastrow + 1, 5).Value = txtQty.Text
Cells(lastrow + 1, 6).Value = cmbUnit.Text
Cells(lastrow + 1, 7).Value = txtPrice.Text
Cells(lastrow + 1, 9).Value = cmbType.Text
Cells(lastrow + 1, 10).Value = cmbSubType.Text
Cells(lastrow + 1, 11).Value = cmbSupplier.Text

Range("A1").Select
cmbUnit = ""
txtItem.Text = ""
txtQty.Text = ""
txtPrice.Text = ""
cmbType = ""
cmbSubType = ""

End Sub

Private Sub UserForm_Initialize()
currentrow = 1
If currentrow = 1 Then
MsgBox " you are now in the header row. Click Next to see the first data!"
cmbDate.Text = ""
cmbMonth.Text = ""
cmbYears = ""
txtItem.Text = ""
txtQty.Text = ""
txtPrice.Text = ""


With Me.cmbDate
.AddItem "1"
.AddItem "2"
.AddItem "3"
.AddItem "4"
.AddItem "5"
.AddItem "6"
.AddItem "7"
.AddItem "8"
.AddItem "9"
.AddItem "10"
.AddItem "11"
.AddItem "12"
.AddItem "13"
.AddItem "14"
.AddItem "15"
.AddItem "16"
.AddItem "17"
.AddItem "18"
.AddItem "19"
.AddItem "20"
.AddItem "21"
.AddItem "22"
.AddItem "23"
.AddItem "24"
.AddItem "25"
.AddItem "26"
.AddItem "27"
.AddItem "28"
.AddItem "29"
.AddItem "30"
.AddItem "31"
End With

With Me.cmbMonth
.AddItem "1"
.AddItem "2"
.AddItem "3"
.AddItem "4"
.AddItem "5"
.AddItem "6"
.AddItem "7"
.AddItem "8"
.AddItem "9"
.AddItem "10"
.AddItem "11"
.AddItem "12"
End With

With Me.cmbYears
.AddItem "2017"
.AddItem "2018"
.AddItem "2019"
.AddItem "2020"
.AddItem "2021"
.AddItem "2022"
End With

With Me.cmbUnit
.AddItem "Kg"
.AddItem "pcs"
.AddItem "L"
.AddItem "buah"
.AddItem "can"
.AddItem "tray"
.AddItem "box"
.AddItem "botol"
.AddItem "times"
.AddItem "lembar"
.AddItem "month"
.AddItem "tabung"
.AddItem "ikat"
End With

With Me.cmbSubType
.AddItem "F&B"
.AddItem "INVESTMENT"
.AddItem "LABOR"
.AddItem "MAINTENANCE"
.AddItem "MARKETING"
.AddItem "OPERATIONAL"
.AddItem "UTILITIES"
End With

With Me.cmbType
.AddItem "AGE.DONATION"
.AddItem "AGE. PRINTING O. SUP."
.AddItem "AGE.SCURUTY"
.AddItem "AGE.TELEPHONE"
.AddItem "AGE.TRANSPORT"
.AddItem "BEVERAGE"
.AddItem "DOE.CLEANING SUPPLIES"
.AddItem "DOE.DECORATION"
.AddItem "DOE.EXTERMINATING"
.AddItem "DOE. PAPER & PLASTICT"
.AddItem "DOE.SERVICE WARE"
.AddItem "EMPLOYEE BENEFIT"
.AddItem "EQUIPMENT"
.AddItem "FOOD"
.AddItem "LEGALITAS"
.AddItem "MARKETING"
.AddItem "MKT.DRIVER COMMISION"
.AddItem "PRIVATE"
.AddItem "RESEARCH"
.AddItem "RM. BUILDING IMP."
.AddItem "RM.ELECTRICAL"
.AddItem "RM.EQUIPMENT"
.AddItem "SALARIES"
.AddItem "UTI.ELECTRICAL"
.AddItem "UTI.LPG"
.AddItem "UTI.PETROL"
End With

With Me.cmbSupplier
.AddItem "VEGETABLE HENDRI"
.AddItem "JOIN"
.AddItem "VEGETABLE ZUL"
.AddItem "DROP IN"
.AddItem "AMAT"
.AddItem "BANYU URIP"
.AddItem "JASMINE"
.AddItem "RAJA KENTANG"
.AddItem "H.JENUN"
.AddItem "KUBUS"
.AddItem "Langgeng Makmur Kencana"
.AddItem "PT. Inti Sari Buana"
.AddItem "LOTUS"
.AddItem "COCA COLA COMPANY"
.AddItem "CV 88"
.AddItem "ALFAMART"
.AddItem "DEDY 'S"
.AddItem "WINE STATION"
.AddItem "ACE HARDWARE"
.AddItem "GAJAH GOTRA BALI"
.AddItem "OJEK"
.AddItem "FLORIST"
.AddItem "INDOMARET"
.AddItem "MDX"
.AddItem "Natural Computer"
.AddItem "NUSA FISHINDO"
.AddItem "PAID"
.AddItem "PANDAN"
.AddItem "PDAM"
.AddItem "PT. LOMBOK MITRA UTAMA"
.AddItem "SANDUBAYA SERVICE"
.AddItem "SASAK JAYA"
.AddItem "SHOPEE"
.AddItem "SLCA"
.AddItem "SMART CLUB"
.AddItem "Surya Laut Sentosa"
.AddItem "TRI PUTRI"
.AddItem "UD.BAROKAH"
.AddItem "NATURA ENERGY"
End With

End If
End Sub

 

Thank you in advance,

 

Ridwan

 


Picture 1. Userform ExpensesPicture 2. Expenses Table

No RepliesBe the first to reply

Resources