Scribd
Upload
143 views10 pages

VBA Inventory Management

This document contains coding for several userforms used in an inventory management system. The coding defines functions for: 1. Adding, deleting, and updating product data in various sheets through userforms. 2. Generating unique transaction IDs when adding new records. 3. Looking up product data from sheets and populating fields in the forms. 4. Calculating totals and performing validation when adding or updating records. 5. Searching and filtering product lists in the forms. The coding manages input, storage, retrieval and updating of inventory product and transaction records across multiple Excel sheets using userforms.

Uploaded by

Novia Hylsandy
Copyright
© © All Rights Reserved
We take content rights seriously. If you suspect this is your content, claim it here.
Available Formats
Download as DOCX, PDF, TXT or read online on Scribd
143 views10 pages

VBA Inventory Management

This document contains coding for several userforms used in an inventory management system. The coding defines functions for: 1. Adding, deleting, and updating product data in various sheets through userforms. 2. Generating unique transaction IDs when adding new records. 3. Looking up product data from sheets and populating fields in the forms. 4. Calculating totals and performing validation when adding or updating records. 5. Searching and filtering product lists in the forms. The coding manages input, storage, retrieval and updating of inventory product and transaction records across multiple Excel sheets using userforms.

Uploaded by

Novia Hylsandy
Copyright
© © All Rights Reserved
We take content rights seriously. If you suspect this is your content, claim it here.
Available Formats
Download as DOCX, PDF, TXT or read online on Scribd
You are on page 1/ 10

CODING USERFORM

A. CODING FORM BARANG


Private Sub CMDADD_Click()
'Perintah membuat nama tempat simpan data
Dim DB_BARANG As Object
Dim Db_Inventory As Obje ct
'Perintah menentukan letak tempat simpan data
Set DB_BARANG = Sheet2.Range("A100000").End(xlUp)
Set Db_Inventory = Sheet5.Range("A100000").End(xlUp)
If Me.TXTID.Value = "" _
Or Me.TXTNAMA.Value = "" _
Or Me.CBSATUAN.Value = "" _
Or Me.TXTCOST.Value = "" _
Or Me.TXTPRICE.Value = "" _
Or Me.TXTLACI.Value = "" _
Or Me.TXTORDER.Value = "" Then
Call MsgBox("Maaf, data input harus lengkap", vbInformation, "Input Data")
Else
'Perintah menyimpan data di tempat simpan data
DB_BARANG.Offset(1, 0).Value = Me.TXTID.Value
DB_BARANG.Offset(1, 1).Value = Me.TXTNAMA.Value
DB_BARANG.Offset(1, 2).Value = Me.CBSATUAN.Value
DB_BARANG.Offset(1, 3).Value = Me.TXTCOST.Value
DB_BARANG.Offset(1, 4).Value = Me.TXTPRICE.Value
DB_BARANG.Offset(1, 5).Value = Me.TXTLACI.Value
DB_BARANG.Offset(1, 6).Value = Me.TXTORDER.Value

Db_Inventory.Offset(1, 0).Value = Me.TXTID.Value


Db_Inventory.Offset(1, 1).Value = Me.TXTNAMA.Value
Db_Inventory.Offset(1, 2).Value = Me.CBSATUAN.Value

'Perintah memunculkan pesan ketika data berhasil disimpan


Call MsgBox("Data anda berhasil disimpan", vbInformation, "Input Data")
'Perintah membersihkan form setelah data tersimpan
Me.TXTID.Value = ""
Me.TXTNAMA.Value = ""
Me.CBSATUAN.Value = ""
Me.TXTCOST.Value = ""
Me.TXTPRICE.Value = ""
Me.TXTLACI.Value = ""
Me.TXTORDER.Value = ""
End If
End Sub

Private Sub CMDDELETE_Click()


If Me.TXTID.Value = "" Then
Call MsgBox("Pilih data pada tabel data", vbInformation, "Hapus Data")
Else
'Membuat pesan konfirmasi hapus data
Select Case MsgBox("Anda akan menghapus data" _
& vbCrLf & "Apakah anda yakin?" _
, vbYesNo Or vbQuestion Or vbDefaultButton1, "Hapus data")
Case vbNo
Exit Sub
Case vbYes
End Select
'Menentukan tempat hapus data, menghapus data dan membersihkan form
Set Hapusdata1 = Sheet2.Range("A5:A500000").Find(What:=Me.TXTID.Value,
LookIn:=xlValues)
Set Hapusdata2 = Sheet5.Range("A5:A500000").Find(What:=Me.TXTID.Value,
LookIn:=xlValues)

Hapusdata1.Offset(0, 0).ClearContents
Hapusdata1.Offset(0, 1).ClearContents
Hapusdata1.Offset(0, 2).ClearContents
Hapusdata1.Offset(0, 3).ClearContents
Hapusdata1.Offset(0, 4).ClearContents
Hapusdata1.Offset(0, 5).ClearContents
Hapusdata1.Offset(0, 6).ClearContents

Hapusdata2.Offset(0, 0).ClearContents
Hapusdata2.Offset(0, 1).ClearContents
Hapusdata2.Offset(0, 2).ClearContents

Call MsgBox("Data berhasil dihapus", vbInformation, "Hapus Data")


Me.TXTID.Value = ""
Me.TXTNAMA.Value = ""
Me.CBSATUAN.Value = ""
Me.TXTCOST.Value = ""
Me.TXTPRICE.Value = ""
Me.TXTLACI.Value = ""
Me.TXTORDER.Value = ""
Call UrutBarang
End If

End Sub

Private Sub CMDUPDATE_Click()


Application.ScreenUpdating = False
Dim BARIS As String

If Me.TXTID.Text = "" Then


Call MsgBox("Pilih data terlebih dahulu", vbInformation, "Pilih Data")
Else
Sheet2.Select
BARIS = ActiveCell.Row

Cells(BARIS, 1) = Me.TXTID.Value
Cells(BARIS, 2) = Me.TXTNAMA.Value
Cells(BARIS, 3) = Me.CBSATUAN.Value
Cells(BARIS, 4) = Me.TXTCOST.Value
Cells(BARIS, 5) = Me.TXTPRICE.Value
Cells(BARIS, 6) = Me.TXTLACI.Value
Cells(BARIS, 7) = Me.TXTORDER.Value

Call MsgBox("Data berhasil diubah", vbInformation, "Ubah Data")


Me.TXTID.Value = ""
Me.TXTNAMA.Value = ""
Me.CBSATUAN.Value = ""
Me.TXTCOST.Value = ""
Me.TXTPRICE.Value = ""
Me.TXTLACI.Value = ""
Me.TXTORDER.Value = ""
End If
Sheet1.Select

End Sub

Private Sub UserForm_Initialize()


Application.ScreenUpdating = False
Me.BackColor = RGB(38, 35, 62)
With CBSATUAN
.AddItem "Pcs"
.AddItem "Buah"
.AddItem "Kotak"
.AddItem "Pack"
End With

End Sub

B. CODING FORM IN OUT


Private Sub CMDADD_Click()
'Perintah membuat nama tempat simpan data
Dim DB_INOUT As Object
'Perintah menentukan letak tempat simpan data
Set DB_INOUT = Sheet3.Range("A100000").End(xlUp)
If Me.TXTID.Value = "" _
Or Me.TXTTANGGALINPUT.Value = "" _
Or Me.TXTIDBARANG.Value = "" _
Or Me.CBSTOK.Value = "" _
Or Me.TXTQTY.Value = "" Then
Call MsgBox("Maaf, data input harus lengkap", vbInformation, "Input Data")
Else
'Perintah menyimpan data di tempat simpan data
DB_INOUT.Offset(1, 0).Value = Me.TXTID.Value
DB_INOUT.Offset(1, 1).Value = Format(Me.TXTTANGGALINPUT.Value, "mm/dd/YYYY")
DB_INOUT.Offset(1, 2).Value = Me.TXTIDBARANG.Value
DB_INOUT.Offset(1, 3).Value = Me.TXTNAMA.Value
DB_INOUT.Offset(1, 4).Value = Me.TXTSATUAN.Value
DB_INOUT.Offset(1, 5).Value = Me.CBSTOK.Value
DB_INOUT.Offset(1, 6).Value = Me.TXTQTY.Value
DB_INOUT.Offset(1, 7).Value = Me.TXTNOMORLACI.Value
DB_INOUT.Offset(1, 8).Value = Me.TXTCOST.Value
DB_INOUT.Offset(1, 9).Value = Me.TXTPRICE.Value
DB_INOUT.Offset(1, 10).Value = Me.TXTTOTALCOST.Value
DB_INOUT.Offset(1, 11).Value = Me.TXTTOTALPRICE.Value
'Perintah memunculkan pesan ketika data berhasil disimpan
Call MsgBox("Data anda berhasil disimpan", vbInformation, "Input Data")
'Perintah membersihkan form setelah data tersimpan
Me.TXTID.Value = ""
Me.TXTTANGGALINPUT.Value = ""
Me.TXTIDBARANG.Value = ""
Me.TXTNAMA.Value = ""
Me.TXTSATUAN.Value = ""
Me.TXTQTY.Value = ""
Me.TXTNOMORLACI.Value = ""
Me.TXTCOST.Value = ""
Me.TXTPRICE.Value = ""
Me.TXTTOTALCOST.Value = ""
Me.TXTTOTALPRICE.Value = ""
End If

End Sub

Private Sub CMDNEW_Click()


Sheet3.Range("B2").Value = Sheet3.Range("B2").Value + 1
If Sheet3.Range("C2").Value = 1 Then
Me.TXTID.Value = "TR-0000" & Sheet3.Range("B2").Value
End If
If Sheet3.Range("C2").Value = 2 Then
Me.TXTID.Value = "TR-000" & Sheet3.Range("B2").Value
End If
If Sheet3.Range("C2").Value = 3 Then
Me.TXTID.Value = "TR-00" & Sheet3.Range("B2").Value
End If
If Sheet3.Range("C2").Value = 4 Then
Me.TXTID.Value = "TR-0" & Sheet3.Range("B2").Value
End If
If Sheet3.Range("C2").Value = 5 Then
Me.TXTID.Value = "TR-" & Sheet3.Range("B2").Value
End If
End Sub

Private Sub TABELDATA_DblClick(ByVal Cancel As MSForms.ReturnBoolean)


On Error GoTo EXCELVBA
Me.TXTIDBARANG.Value = Me.TABELDATA.Value
Set CariBarang = Sheet2.Range("A6:A100000").Find(What:=Me.TXTIDBARANG.Text,
LookIn:=xlValues)

Me.TXTIDBARANG.Value = Me.TABELDATA.Value
Me.TXTNAMA.Value = CariBarang.Offset(0, 1).Value
Me.TXTSATUAN.Value = CariBarang.Offset(0, 2).Value
Me.TXTCOST.Value = CariBarang.Offset(0, 3).Value
Me.TXTPRICE.Value = CariBarang.Offset(0, 4).Value
Me.TXTNOMORLACI.Value = CariBarang.Offset(0, 5).Value

Me.TXTIDBARANG.Enabled = False
Me.TXTNAMA.Enabled = False
Me.TXTSATUAN.Enabled = False
Me.TXTCOST.Enabled = False
Me.TXTPRICE.Enabled = False
Me.TXTNOMORLACI.Enabled = False
Me.TXTTOTALCOST.Enabled = False
Me.TXTTOTALPRICE.Enabled = False
Exit Sub
EXCELVBA:
Call MsgBox("Maaf, data barang belum terdaftar", vbInformation, "Data Barang")
End Sub

Private Sub TXTCARI_Change()


On Error GoTo Salah
Dim iRow As Long
Set Cari_Data = Sheet2
Sheet4.Range("I1").Value = "Nama Barang"
Sheet4.Range("I2").Value = "*" & Me.TXTCARI.Value & "*"
Cari_Data.Range("A5").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
Sheet4.Range("I1:I2"), CopyToRange:=Sheet4.Range("A1:G1"), Unique:=False
iRow = Sheet4.Range("A" & Rows.Count).End(xlUp).Row
If iRow > 1 Then
Me.TABELDATA.RowSource = "CARIBARANG!A2:B" & iRow
Else
Call MsgBox("Data tidak ditemukan", vbInformation, "Cari Data")
End If
Exit Sub
Salah:
Call MsgBox("Maaf Data tidak ditemukan", vbInformation, "Cari Data")
End Sub

Private Sub TXTQTY_Change()


On Error Resume Next
Me.TXTTOTALCOST.Value = IIf(Me.TXTQTY.Value = "", 0, Me.TXTQTY.Value) *
IIf(Me.TXTCOST.Value = "", 0, Me.TXTCOST.Value)
Me.TXTTOTALPRICE.Value = IIf(Me.TXTQTY.Value = "", 0, Me.TXTQTY.Value) *
IIf(Me.TXTPRICE.Value = "", 0, Me.TXTPRICE.Value)
End Sub

Private Sub UserForm_Initialize()


Me.BackColor = RGB(38, 35, 62)
With CBSTOK
.AddItem "In"
.AddItem "Out"
.AddItem "Open Stok"
End With
Dim iRow As Long
iRow = Sheet2.Range("A" & Rows.Count).End(xlUp).Row
If iRow > 1 Then
Me.TABELDATA.RowSource = "DATABARANG!A6:B" & iRow
End If
End Sub

C. CODING FORM INVENTORY

Private Sub TABELDATA_Click()


Me.TXTID.Value = Me.TABELDATA.Value
Me.TXTNAMA.Value = Me.TABELDATA.Column(1)
Me.TXTSATUAN.Value = Me.TABELDATA.Column(2)
Me.TXTOPEN.Value = Me.TABELDATA.Column(3)
Me.TXTIN.Value = Me.TABELDATA.Column(4)
Me.TXTOUT.Value = Me.TABELDATA.Column(5)
Me.TXTCLOSE.Value = Me.TABELDATA.Column(6)
Me.TXTVALUE.Value = Me.TABELDATA.Column(7)
Me.TXTCOST.Value = Me.TABELDATA.Column(8)
Me.TXTREORDER.Value = Me.TABELDATA.Column(9)
Me.TXTSTATUS.Value = Me.TABELDATA.Column(10)
Me.TXTLACI.Value = Me.TABELDATA.Column(11)
End Sub
Private Sub UserForm_Initialize()
Me.BackColor = RGB(38, 35, 62)
Dim iRow As Long
iRow = Sheet5.Range("A" & Rows.Count).End(xlUp).Row
If iRow > 1 Then
Me.TABELDATA.RowSource = "INVENTORY!A6:L" & iRow
End If
End Sub

D. CODING FORM TABELBARANG

Private Sub CMDADD_Click()


Application.ScreenUpdating = False
Me.TXTNAMA.Value = ""
Me.TXTSATUAN.Value = ""
Me.TXTLACI.Value = ""
Me.TXTREORDER.Value = ""
Me.TXTCOST.Value = ""
Me.TXTPRICE.Value = ""
Me.TXTSTATUS.Value = ""
FORMBARANG.Show
End Sub

Private Sub CMDUPDATE_Click()


Call UserForm_Initialize
End Sub

Private Sub TABELDATA_Click()


Set CariBarang = Sheet5.Range("A6:A100000").Find(What:=Me.TABELDATA.Value,
LookIn:=xlValues)
Me.TXTNAMA.Value = Me.TABELDATA.Column(1)
Me.TXTSATUAN.Value = Me.TABELDATA.Column(2)
Me.TXTLACI.Value = Me.TABELDATA.Column(5)
Me.TXTREORDER.Value = Me.TABELDATA.Column(6)
Me.TXTCOST.Value = Me.TABELDATA.Column(3)
Me.TXTPRICE.Value = Me.TABELDATA.Column(4)
Me.TXTSTATUS.Value = CariBarang.Offset(0, 10).Value

End Sub

Private Sub TABELDATA_DblClick(ByVal Cancel As MSForms.ReturnBoolean)


End Sub

Private Sub TXTCARI_Change()


On Error GoTo Salah
Dim iRow As Long
Set Cari_Data = Sheet2
Sheet4.Range("I1").Value = "Nama Barang"
Sheet4.Range("I2").Value = "*" & Me.TXTCARI.Value & "*"
Cari_Data.Range("A5").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
Sheet4.Range("I1:I2"), CopyToRange:=Sheet4.Range("A1:G1"), Unique:=False
iRow = Sheet4.Range("A" & Rows.Count).End(xlUp).Row
If iRow > 1 Then
Me.TABELDATA.RowSource = "CARIBARANG!A2:B" & iRow
Else
Call MsgBox("Data tidak ditemukan", vbInformation, "Cari Data")
End If
Exit Sub
Salah:
Call MsgBox("Maaf Data tidak ditemukan", vbInformation, "Cari Data")

End Sub

Private Sub UserForm_Initialize()


Me.BackColor = RGB(38, 35, 62)
Dim iRow As Long
iRow = Sheet2.Range("A" & Rows.Count).End(xlUp).Row
If iRow > 1 Then
Me.TABELDATA.RowSource = "DATABARANG!A6:G" & iRow
End If

End Sub

E. CODING FORM DETAILORDER


Private Sub UserForm_Initialize()
Application.ScreenUpdating = False
Me.BackColor = RGB(38, 35, 62)
Dim iRow As Long
iRow = Sheet6.Range("A" & Rows.Count).End(xlUp).Row
If iRow > 1 Then
Me.ListBox1.RowSource = "CARIORDER!A2:J" & iRow
End If
End Sub

F. CODING URUT DAN MENU

MODUL URUT DAN CARI ORDER


Sub UrutBarang1()
Application.ScreenUpdating = False
Sheet2.Select
Sheet2.Range("A5:G20000").Sort KEY1:=Range("B5"), Order1:=xlAscending, Header:=xlYes
Sheet1.Select
End Sub
Sub UrutBarang2()
Application.ScreenUpdating = False
Sheet5.Select
Sheet5.Range("A5:G20000").Sort KEY1:=Range("B5"), Order1:=xlAscending, Header:=xlYes
Sheet1.Select
End Sub

Sub Cari_Order()
On Error GoTo Salah
Dim iRow As Long
Set Cari_Data = Sheet5
Cari_Data.Range("A5").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
Sheet6.Range("N1:N2"), CopyToRange:=Sheet6.Range("A1:L1"), Unique:=False
Exit Sub
Salah:
Call MsgBox("Maaf Data tidak ditemukan", vbInformation, "Cari Data")
End Sub

MODUL MENU
Sub BukaFormBarang()
FORMTABELBARANG.Show
End Sub
Sub BukaINOUT()
FORMINOUT.Show
End Sub
Sub BukaInventory()
FORMINVENTORY.Show
End Sub
Sub BukaOrder()
Call Cari_Order
DETAILORDER.Show
End Sub
Sub SimpanFile()
ThisWorkbook.Save
End Sub
Sub Keluar()
Select Case MsgBox("Anda akan menghapus data" _
& vbCrLf & "Apakah anda yakin?" _
, vbYesNo Or vbQuestion Or vbDefaultButton1, "Hapus data")
Case vbNo
Exit Sub
Case vbYes
End Select
ThisWorkbook.Save
ThisWorkbook.close
End Sub

You might also like