VBA Code:
Private Sub Image2_Click()
End Sub
Private Sub cmdProduct_Change()
End Sub
Private Sub AvailableStocks_Click()
End Sub
Private Sub cmb_Product_Change()
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Product_Master")
If Me.cmb_Product.Value = "" Or Me.cmb_Type.Value = "" Then Me.txt_Rate.Value = ""
Dim rate As Double ' Or String, not sure what your data is.
On Error Resume Next
rate = WorksheetFunction.VLookup(Me.cmb_Product, sh.Range("B:D"), 2, False)
On Error GoTo 0
Me.txt_Rate.Value = rate
On Error Resume Next
rate = WorksheetFunction.VLookup(Me.cmb_Product, sh.Range("B:D"), 3, False)
On Error GoTo 0
Me.txt_Rate.Value = rate
End Sub
Private Sub cmb_Type_Change()
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Product_Master")
If Me.cmb_Product.Value = "" Or Me.cmb_Type.Value = "" Then Me.txt_Rate.Value = ""
If Me.cmb_Type.Value = "Sale" Then
Me.txt_Rate.Value = Application.WorksheetFunction.VLookup(Me.cmb_Product, sh.Range("B:D"), 2, 0)
ElseIf Me.cmb_Type.Value = "Purchase" Then
Me.txt_Rate.Value = Application.WorksheetFunction.VLookup(Me.cmb_Product, sh.Range("B:D"), 3, 0)
End If
End Sub
Private Sub CommandButton1_Click()
Call Add_Product_list
Call Show_Sale_Purchase_Data
Call Show_Inventory
Call Show_Numbers
End Sub
Private Sub CommandButton2_Click()
frm_ProductMaster.Show False
End Sub
Private Sub CommandButton3_Click()
ThisWorkbook.Save
MsgBox "Data Has been Saved"
End Sub
Private Sub CommandButton4_Click()
Call Show_Inventory
End Sub
Private Sub CommandButton5_Click()
Dim nwb As Workbook
Set nwb = Workbooks.Add
ThisWorkbook.Sheets("Inventory_Display").UsedRange.Copy nwb.Sheets(1).Range("A1")
End Sub
Private Sub CommandButton6_Click()
'''''''' Validation ''''''''''
If Me.cmb_Product.Value = "" Then
MsgBox "Please selet the Product", vbCritical
Exit Sub
End If
If IsNumeric(Me.txtQty) = False Then
MsgBox "Please enter correct QTY", vbCritical
Exit Sub
End If
If Me.cmb_Type.Value = "" Then
MsgBox "Please selet the Type", vbCritical
Exit Sub
End If
'''''''''''' Add Data
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Sale_Purchase")
Dim lr As Long
lr = Application.WorksheetFunction.CountA(sh.Range("A:A"))
sh.Range("A" & lr + 1).Value = lr
sh.Range("B" & lr + 1).Value = Me.cmb_Product.Value
sh.Range("C" & lr + 1).Value = Me.cmb_Type.Value
sh.Range("D" & lr + 1).Value = Me.txtQty.Value
sh.Range("E" & lr + 1).Value = Me.txt_Rate.Value
sh.Range("F" & lr + 1).Value = Me.txt_Rate.Value * Me.txtQty.Value
If Me.cmb_Type.Value = "Purchase" Then
sh.Range("G" & lr + 1).Value = "NA"
Else
sh.Range("G" & lr + 1).Value = (Me.txt_Rate.Value * Me.txtQty.Value) - Application.WorksheetFunction.VLookup(Me.cmb_Product, ThisWorkbook.Sheets("Product_Master").Range("B:D"), 3, 0) * Me.txtQty.Value
End If
sh.Range("H" & lr + 1).Value = Me.txt_Date.Value
''''''''''' CLEAR BOXES
Me.cmb_Product.Value = ""
Me.cmb_Type.Value = ""
Me.cmb_Type.Value = ""
Me.txt_Rate.Value = ""
Call Show_Sale_Purchase_Data
Call Show_Inventory
Call Show_Numbers
MsgBox "Data has been added", vbInformation
End Sub
Private Sub CommandButton7_Click()
'''''''' Validation ''''''''''
If Me.cmb_Product.Value = "" Then
MsgBox "Please selet the Product", vbCritical
Exit Sub
End If
If IsNumeric(Me.txtQty) = False Then
MsgBox "Please enter correct QTY", vbCritical
Exit Sub
End If
If Me.cmb_Type.Value = "" Then
MsgBox "Please selet the Type", vbCritical
Exit Sub
End If
'''''''''''' Update Data
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Sale_Purchase")
Dim lr As Long
lr = Me.txt_id.Value
sh.Range("A" & lr + 1).Value = lr
sh.Range("B" & lr + 1).Value = Me.cmb_Product.Value
sh.Range("C" & lr + 1).Value = Me.cmb_Type.Value
sh.Range("D" & lr + 1).Value = Me.txtQty.Value
sh.Range("E" & lr + 1).Value = Me.txt_Rate.Value
sh.Range("F" & lr + 1).Value = Me.txt_Rate.Value * Me.txtQty.Value
If Me.cmb_Type.Value = "Purchase" Then
sh.Range("G" & lr + 1).Value = "NA"
Else
sh.Range("G" & lr + 1).Value = (Me.txt_Rate.Value * Me.txtQty.Value) - Application.WorksheetFunction.VLookup(Me.cmb_Product, ThisWorkbook.Sheets("Product_Master").Range("B:D"), 3, 0) * Me.txtQty.Value
End If
sh.Range("H" & lr + 1).Value = Me.txt_Date.Value
''''''''''' CLEAR BOXES
Me.cmb_Product.Value = ""
Me.cmb_Type.Value = ""
Me.cmb_Type.Value = ""
Me.txt_Rate.Value = ""
Me.txt_id.Value = ""
Call Show_Sale_Purchase_Data
Call Show_Inventory
Call Show_Numbers
MsgBox "Data has been updated", vbInformation
End Sub
Private Sub CommandButton8_Click()
Dim nwb As Workbook
Set nwb = Workbooks.Add
ThisWorkbook.Sheets("Sale_Purchase_Display").UsedRange.Copy nwb.Sheets(1).Range("A1")
End Sub
Private Sub Image4_Click()
End Sub
Private Sub Image10_Click()
Call Calendar.SelectedDate(Me.txt_Date)
End Sub
Private Sub Image11_Click()
Call Calendar.SelectedDate(Me.txt_StartDate)
End Sub
Private Sub Image3_Click()
Call Calendar.SelectedDate(Me.txt_EndDate)
End Sub
Private Sub TxtEndDate_Change()
End Sub
Private Sub Image5_Click()
End Sub
Private Sub Image6_Click()
End Sub
Private Sub Image8_Click()
End Sub
Private Sub ListBox2_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Me.txt_id.Value = Me.ListBox2.List(Me.ListBox2.ListIndex, 0)
Me.cmb_Product.Value = Me.ListBox2.List(Me.ListBox2.ListIndex, 1)
Me.txtQty.Value = Me.ListBox2.List(Me.ListBox2.ListIndex, 3)
Me.cmb_Type.Value = Me.ListBox2.List(Me.ListBox2.ListIndex, 2)
Me.txt_Rate.Value = Me.ListBox2.List(Me.ListBox2.ListIndex, 4)
Me.txt_Date.Value = Format(Me.ListBox2.List(Me.ListBox2.ListIndex, 7), "D-MMM-YYYY")
End Sub
Private Sub OptionButton1_Click()
Call Show_Sale_Purchase_Data
End Sub
Private Sub OptionButton3_Click()
Call Show_Sale_Purchase_Data
End Sub
Private Sub OptionButton4_Click()
Call Show_Sale_Purchase_Data
End Sub
Private Sub txt_EndDate_Change()
End Sub
Private Sub UserForm_Initialize()
Me.txt_StartDate.Value = Format(Date, "D-MMM-YYYY")
Me.txt_EndDate.Value = Format(Date, "D-MMM-YYYY")
Me.txt_Date.Value = Format(Date, "D-MMM-YYYY")
'''''''''' Drop Down FOR TYPE
With Me.cmb_Type
.AddItem ""
.AddItem "Sale"
.AddItem "Purchase"
End With
Call Add_Product_list
Call Show_Sale_Purchase_Data
Call Show_Inventory
Call Show_Numbers
End Sub
Sub Add_Product_list()
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Product_Master")
Dim i As Integer
Me.cmb_Product.Clear
Me.cmb_Product.AddItem ""
For i = 2 To Application.WorksheetFunction.CountA(sh.Range("A:A"))
Me.cmb_Product.AddItem sh.Range("B" & i)
Next i
End Sub
Sub Show_Sale_Purchase_Data()
Dim dsh As Worksheet
Dim sh As Worksheet
Set dsh = ThisWorkbook.Sheets("Sale_Purchase")
Set sh = ThisWorkbook.Sheets("Sale_Purchase_Display")
dsh.AutoFilterMode = False
dsh.Range("H:H").NumberFormat = "D-MMM-YYYY"
'''''''' PUTTING FILTER ''''''''
dsh.UsedRange.AutoFilter 8, ">=" & Me.txt_StartDate.Value, xlAnd, "<=" & Me.txt_EndDate.Value
If Me.OptionButton4.Value = True Then
dsh.UsedRange.AutoFilter 3, "Purchase"
End If
If Me.OptionButton3.Value = True Then
dsh.UsedRange.AutoFilter 3, "Sale"
End If
sh.UsedRange.Clear
dsh.UsedRange.Copy
sh.Range("A1").PasteSpecial xlPasteValuesAndNumberFormats
dsh.AutoFilterMode = False
'''''''''''''''''' Display Data in Listbox
Dim lr As Long
lr = Application.WorksheetFunction.CountA(sh.Range("A:A"))
If lr = 1 Then lr = 2
With Me.ListBox2
.ColumnCount = 8
.ColumnHeads = True
.ColumnWidths = "0,190,70,70,70,70,70,70"
.RowSource = sh.Name & "!A2:H" & lr
End With
End Sub
Sub Show_Inventory()
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Inventory")
sh.Cells.Clear
ThisWorkbook.Sheets("Product_Master").Range("B:B").Copy sh.Range("A1")
sh.Range("B1").Value = "Purchase"
sh.Range("C1").Value = "Sale"
sh.Range("D1").Value = "Available Stock"
sh.Range("E1").Value = "Stock Value"
Dim lr As Long
lr = Application.WorksheetFunction.CountA(sh.Range("A:A"))
If lr > 1 Then
sh.Range("B2").Value = "=SUMIFS(Sale_Purchase!D:D,Sale_Purchase!B:B,Inventory!A2,Sale_Purchase!C:C,""Purchase"")"
sh.Range("C2").Value = "=SUMIFS(Sale_Purchase!D:D,Sale_Purchase!B:B,Inventory!A2,Sale_Purchase!C:C,""Sale"")"
sh.Range("D2").Value = "=B2-C2"
sh.Range("E2").Value = "=VLOOKUP(A2,Product_Master!B:C,2,FALSE) *D2"
If lr > 2 Then
sh.Range("B2:E" & lr).FillDown
End If
sh.Calculate
End If
sh.UsedRange.Copy
sh.UsedRange.PasteSpecial xlPasteValues
Dim inv_Display As Worksheet
Set inv_Display = ThisWorkbook.Sheets("Inventory_Display")
inv_Display.Cells.Clear
If Me.txtSearch.Value <> "" Then
sh.UsedRange.AutoFilter 1, "*" & Me.txtSearch.Value & "*"
End If
sh.UsedRange.Copy inv_Display.Range("A1")
'''''''''''''''''''''' show data
lr = Application.WorksheetFunction.CountA(inv_Display.Range("A:A"))
If lr = 1 Then lr = 2
With Me.ListBox1
.ColumnCount = 5
.ColumnHeads = True
.ColumnWidths = "150,0,0,80,0"
.RowSource = inv_Display.Name & "!A2:E" & lr
End With
End Sub
Sub Show_Numbers()
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Report")
sh.Range("C1").Value = Me.txt_StartDate.Value
sh.Range("C2").Value = Me.txt_EndDate.Value
sh.Calculate
Me.LblPurchase.Caption = sh.Range("C4").Value
Me.lbSale.Caption = sh.Range("C5").Value
Me.lblProfit.Caption = sh.Range("C6").Value
Me.lblInventory.Caption = sh.Range("C7").Value
Me.lblInventory1.Caption = sh.Range("C8").Value
End Sub
This is my full code. The first error shows in the Initialization userform. It highlights the word "Date"
Last edited by a moderator: