Hi Experts,
I am making an Inventory Management file by looking at some online videos and stuck in the 1st part i.e. Purchase.
1st-row entries are moving perfectly from tab "Form" to tab "Dashboard" but do not know how to put formula so it can move more than 1 row in 1 purchase entry like 1 invoice many products, need help, please.
Form
Dashboard
VBA
Option Explicit
Function Validate() As Boolean
Dim frm As Worksheet
Set frm = ThisWorkbook.Sheets("Form")
Validate = True
With frm
.Range("G5").Interior.Color = xlNone
.Range("K5").Interior.Color = xlNone
.Range("K7").Interior.Color = xlNone
.Range("E10").Interior.Color = xlNone
.Range("G10").Interior.Color = xlNone
.Range("H10").Interior.Color = xlNone
.Range("I10").Interior.Color = xlNone
.Range("J10").Interior.Color = xlNone
.Range("K10").Interior.Color = xlNone
.Range("I35").Interior.Color = xlNone
.Range("I36").Interior.Color = xlNone
.Range("L35").Interior.Color = xlNone
End With
'Validating Supplier Name
If Trim(frm.Range("G5").Value) = "" Then
MsgBox "Supplier Name is blank.", vbOKOnly + vbInformation, "Supplier Name"
frm.Range("G5").Select
frm.Range("G5").Interior.Color = vbRed
Validate = False
Exit Function
End If
'Validating Invoice/Bill No.
If Trim(frm.Range("K5").Value) = "" Then
MsgBox "Invoice/Bill No. is blank.", vbOKOnly + vbInformation, "Invoice/Bill No."
frm.Range("K5").Select
frm.Range("K5").Interior.Color = vbRed
Validate = False
Exit Function
End If
'Validating Invoice Date
If Trim(frm.Range("K7").Value) = "" Then
MsgBox "Invoice Date is blank", vbOKOnly + vbInformation, "Invoice Date"
frm.Range("K7").Select
frm.Range("K7").Interior.Color = vbRed
Validate = False
Exit Function
End If
'Validating Brand (Quality)
If Trim(frm.Range("E10").Value) = "" Then
MsgBox "Quality is blank", vbOKOnly + vbInformation, "Brand (Quality)"
frm.Range("E10").Select
frm.Range("E10").Interior.Color = vbRed
Validate = False
Exit Function
End If
'Validating Gram
If Trim(frm.Range("G10").Value) = "" Or Not IsNumeric(Trim(frm.Range("G10").Value)) Then
MsgBox "Please ender valid Gram", vbOKOnly + vbInformation, "Gram"
frm.Range("G10").Select
frm.Range("G10").Interior.Color = vbRed
Validate = False
Exit Function
End If
'Validating Quantity
If Trim(frm.Range("H10").Value) = "" Or Not IsNumeric(Trim(frm.Range("H10").Value)) Then
MsgBox "Please ender valid Quantity", vbOKOnly + vbInformation, "Quantity"
frm.Range("H10").Select
frm.Range("H10").Interior.Color = vbRed
Validate = False
Exit Function
End If
'Validating Size
If Trim(frm.Range("I10").Value) = "" Or Not IsNumeric(Trim(frm.Range("I10").Value)) Then
MsgBox "Please ender valid Size", vbOKOnly + vbInformation, "Quantity"
frm.Range("I10").Select
frm.Range("I10").Interior.Color = vbRed
Validate = False
Exit Function
End If
'Validating Weight
If Trim(frm.Range("J10").Value) = "" Or Not IsNumeric(Trim(frm.Range("J10").Value)) Then
MsgBox "Please ender valid Weight", vbOKOnly + vbInformation, "Weight"
frm.Range("J10").Select
frm.Range("J10").Interior.Color = vbRed
Validate = False
Exit Function
End If
'Validating Rate
If Trim(frm.Range("K10").Value) = "" Or Not IsNumeric(Trim(frm.Range("K10").Value)) Then
MsgBox "Please ender valid Rate", vbOKOnly + vbInformation, "Rate"
frm.Range("K10").Select
frm.Range("K10").Interior.Color = vbRed
Validate = False
Exit Function
End If
'Validating Vehicle No.
If Trim(frm.Range("I35").Value) = "" Then
MsgBox "Vehicle No. is blank", vbOKOnly + vbInformation, "Vehicle No."
frm.Range("I35").Select
frm.Range("I35").Interior.Color = vbRed
Validate = False
Exit Function
End If
'Validating Driver Name
If Trim(frm.Range("I36").Value) = "" Then
MsgBox "Driver Name is blank", vbOKOnly + vbInformation, "Driver Name"
frm.Range("I36").Select
frm.Range("I36").Interior.Color = vbRed
Validate = False
Exit Function
End If
'Validating Carrtage
If Trim(frm.Range("L35").Value) = "" Then
MsgBox "Cartage is blank if no charges put zero", vbOKOnly + vbInformation, "Cartage"
frm.Range("L35").Select
frm.Range("L35").Interior.Color = vbRed
Validate = False
Exit Function
End If
End Function
Sub Reset()
With Sheets("Form")
.Range("G5").Interior.Color = xlNone
.Range("G5").Value = ""
.Range("K5").Interior.Color = xlNone
.Range("K5").Value = ""
.Range("K7").Interior.Color = xlNone
.Range("K7").Value = ""
.Range("E10:E24").Interior.Color = xlNone
.Range("E10:E24").Value = ""
.Range("G10").Interior.Color = xlNone
.Range("G10").Value = ""
.Range("H10").Interior.Color = xlNone
.Range("H10").Value = ""
.Range("I10").Interior.Color = xlNone
.Range("I10").Value = ""
.Range("J10").Interior.Color = xlNone
.Range("J10").Value = ""
.Range("K10").Interior.Color = xlNone
.Range("K10").Value = ""
.Range("I35").Interior.Color = xlNone
.Range("I35").Value = ""
.Range("I36").Interior.Color = xlNone
.Range("I36").Value = ""
.Range("L35").Interior.Color = xlNone
.Range("L35").Value = ""
End With
End Sub
Sub Save()
Dim frm As Worksheet
Dim database As Worksheet
Dim iRow As Long
Dim iSerial As Long
Set frm = ThisWorkbook.Sheets("Form")
Set database = ThisWorkbook.Sheets("Database")
If Trim(frm.Range("L1").Value) = "" Then
iRow = database.Range("A" & Application.Rows.Count).End(xlUp).Row + 1
If iRow = 2 Then
iSerial = 1
Else
iSerial = database.Cells(iRow - 1, 1).Value + 1
End If
Else
iRow = frm.Range("K1").Value
iSerial = frm.Range("L1").Value
End If
With database
.Cells(iRow, 1).Value = iSerial
.Cells(iRow, 2).Value = frm.Range("G7").Value
.Cells(iRow, 3).Value = frm.Range("G5").Value
.Cells(iRow, 4).Value = frm.Range("K5").Value
.Cells(iRow, 5).Value = frm.Range("K7").Value
.Cells(iRow, 6).Value = frm.Range("E10:E24").Value
.Cells(iRow, 7).Value = frm.Range("G10").Value
.Cells(iRow, 8).Value = frm.Range("H10").Value
.Cells(iRow, 9).Value = frm.Range("I10").Value
.Cells(iRow, 10).Value = frm.Range("J10").Value
.Cells(iRow, 11).Value = frm.Range("K10").Value
.Cells(iRow, 12).Value = frm.Range("L10").Value
.Cells(iRow, 13).Value = frm.Range("L35").Value
.Cells(iRow, 14).Value = frm.Range("I35").Value
.Cells(iRow, 15).Value = frm.Range("I36").Value
.Cells(iRow, 16).Value = Application.UserName
.Cells(iRow, 17).Value = [Text(Now(), "DD-MM-YYYY HH:MM:SS")]
End With
frm.Range("K1").Value = ""
frm.Range("L1").Value = ""
End Sub
Sub Modify()
Dim iRow As Long
Dim iSerial As Long
iSerial = Application.InputBox("Please enter Serial Number to make modification.", "Modify", , , , , , 1)
On Error Resume Next
iRow = Application.WorksheetFunction.IfError _
(Application.WorksheetFunction.Match(iSerial, Sheets("Database").Range("A:A"), 0), 0)
On Error GoTo 0
If iRow = 0 Then
MsgBox "No record found.", vbOKOnly + vbCritical, "No Record"
Exit Sub
End If
Sheets("Form").Range("K1").Value = iRow
Sheets("Form").Range("L1").Value = iSerial
Sheets("Form").Range("G5").Value = Sheets("Database").Cells(iRow, 3).Value
Sheets("Form").Range("K5").Value = Sheets("Database").Cells(iRow, 4).Value
Sheets("Form").Range("G7").Value = Sheets("Database").Cells(iRow, 2).Value
Sheets("Form").Range("K7").Value = Sheets("Database").Cells(iRow, 5).Value
Sheets("Form").Range("E10:E24").Value = Sheets("Database").Cells(iRow, 6).Value
Sheets("Form").Range("G10").Value = Sheets("Database").Cells(iRow, 7).Value
Sheets("Form").Range("H10").Value = Sheets("Database").Cells(iRow, 8).Value
Sheets("Form").Range("I10").Value = Sheets("Database").Cells(iRow, 9).Value
Sheets("Form").Range("J10").Value = Sheets("Database").Cells(iRow, 10).Value
Sheets("Form").Range("K10").Value = Sheets("Database").Cells(iRow, 11).Value
Sheets("Form").Range("L10").Value = Sheets("Database").Cells(iRow, 12).Value
Sheets("Form").Range("I35").Value = Sheets("Database").Cells(iRow, 13).Value
Sheets("Form").Range("I36").Value = Sheets("Database").Cells(iRow, 14).Value
End Sub
Sub DeleteRecord()
Dim iRow As Long
Dim iSerial As Long
iSerial = Application.InputBox("Please enter S.No. to delete the record.", "Delete", , , , , , 1)
On Error Resume Next
iRow = Application.WorksheetFunction.IfError _
(Application.WorksheetFunction.Match(iSerial, Sheets("Database").Range("A:A"), 0), 0)
On Error GoTo 0
If iRow = 0 Then
MsgBox "No record found.", vbOKOnly + vbCritical, "No Record"
Exit Sub
End If
Sheets("Database").Cells(iRow, 1).EntireRow.Delete shift:=xlUp
End Sub
I am making an Inventory Management file by looking at some online videos and stuck in the 1st part i.e. Purchase.
1st-row entries are moving perfectly from tab "Form" to tab "Dashboard" but do not know how to put formula so it can move more than 1 row in 1 purchase entry like 1 invoice many products, need help, please.
Form
Corrugated Carton Business Model test.xlsm | |||||||||||
---|---|---|---|---|---|---|---|---|---|---|---|
D | E | F | G | H | I | J | K | L | |||
2 | Purchase Data Entry Form | ||||||||||
3 | |||||||||||
4 | |||||||||||
5 | Supplier Name | Invoice/Bill No. | |||||||||
6 | |||||||||||
7 | Supplier No. | 22005 | Invoice Date | ||||||||
8 | |||||||||||
9 | S. No. | Brand (Quality) | Gram | Quantity | Size | Weight | Rate | Amount | |||
10 | 1 | - | |||||||||
11 | 2 | - | |||||||||
12 | 3 | - | |||||||||
13 | 4 | - | |||||||||
14 | 5 | - | |||||||||
15 | 6 | - | |||||||||
16 | 7 | - | |||||||||
17 | 8 | - | |||||||||
18 | 9 | - | |||||||||
19 | 10 | - | |||||||||
20 | 11 | - | |||||||||
21 | 12 | - | |||||||||
22 | 13 | - | |||||||||
23 | 14 | - | |||||||||
24 | 15 | - | |||||||||
25 | 16 | - | |||||||||
26 | 17 | - | |||||||||
27 | 18 | - | |||||||||
28 | 19 | - | |||||||||
29 | 20 | - | |||||||||
30 | 21 | - | |||||||||
31 | 22 | - | |||||||||
32 | 23 | - | |||||||||
33 | 24 | - | |||||||||
34 | Subtotal | - | |||||||||
35 | Vehicle No. | Cartage | |||||||||
36 | Driver Name | TOTAL | - | ||||||||
37 | |||||||||||
Form |
Cell Formulas | ||
---|---|---|
Range | Formula | |
L10:L33 | L10 | =+J10*K10 |
L34 | L34 | =SUM(L10:L33) |
L36 | L36 | =+L35+L34 |
Cells with Data Validation | ||
---|---|---|
Cell | Allow | Criteria |
G5:H5 | List | ='Supplier Details'!$B$4:$B$205 |
K7 | List | ='Supplier Details'!$M$4:$M$10595 |
Dashboard
Corrugated Carton Business Model test.xlsm | |||||||||||||||||||
---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
A | B | C | D | E | F | G | H | I | J | K | L | M | N | O | P | Q | |||
1 | S. No | Supplier No. | Supplier Name | Invoice/Bill No. | Invoice Date | Brand (Quantity) | Gram | Quantity | Size | Weight | Rate | Amount | Cartage | Vehicle No. | Driver Name | Submitted By | Submitted On | ||
2 | 1 | 22005 | Supplier No.95 | 10005 | 1/21/2022 | Dubai | 110 | 1 | 39 | 750 | 60 | 45,000 | 500 | KZ1250 | Driver 10 | ZESSA-Click | 22-01-2022 15:00:35 | ||
3 | 2 | 22005 | Supplier No.100 | 10006 | 1/21/2022 | Gold | 115 | 1 | 36 | 850 | 65 | 55,250 | 250 | KY1500 | Driver 15 | ZESSA-Click | 22-01-2022 15:02:00 | ||
4 | |||||||||||||||||||
5 | |||||||||||||||||||
6 | |||||||||||||||||||
7 | |||||||||||||||||||
8 | |||||||||||||||||||
9 | |||||||||||||||||||
10 | |||||||||||||||||||
11 | |||||||||||||||||||
12 | |||||||||||||||||||
13 | |||||||||||||||||||
Database |
VBA
Option Explicit
Function Validate() As Boolean
Dim frm As Worksheet
Set frm = ThisWorkbook.Sheets("Form")
Validate = True
With frm
.Range("G5").Interior.Color = xlNone
.Range("K5").Interior.Color = xlNone
.Range("K7").Interior.Color = xlNone
.Range("E10").Interior.Color = xlNone
.Range("G10").Interior.Color = xlNone
.Range("H10").Interior.Color = xlNone
.Range("I10").Interior.Color = xlNone
.Range("J10").Interior.Color = xlNone
.Range("K10").Interior.Color = xlNone
.Range("I35").Interior.Color = xlNone
.Range("I36").Interior.Color = xlNone
.Range("L35").Interior.Color = xlNone
End With
'Validating Supplier Name
If Trim(frm.Range("G5").Value) = "" Then
MsgBox "Supplier Name is blank.", vbOKOnly + vbInformation, "Supplier Name"
frm.Range("G5").Select
frm.Range("G5").Interior.Color = vbRed
Validate = False
Exit Function
End If
'Validating Invoice/Bill No.
If Trim(frm.Range("K5").Value) = "" Then
MsgBox "Invoice/Bill No. is blank.", vbOKOnly + vbInformation, "Invoice/Bill No."
frm.Range("K5").Select
frm.Range("K5").Interior.Color = vbRed
Validate = False
Exit Function
End If
'Validating Invoice Date
If Trim(frm.Range("K7").Value) = "" Then
MsgBox "Invoice Date is blank", vbOKOnly + vbInformation, "Invoice Date"
frm.Range("K7").Select
frm.Range("K7").Interior.Color = vbRed
Validate = False
Exit Function
End If
'Validating Brand (Quality)
If Trim(frm.Range("E10").Value) = "" Then
MsgBox "Quality is blank", vbOKOnly + vbInformation, "Brand (Quality)"
frm.Range("E10").Select
frm.Range("E10").Interior.Color = vbRed
Validate = False
Exit Function
End If
'Validating Gram
If Trim(frm.Range("G10").Value) = "" Or Not IsNumeric(Trim(frm.Range("G10").Value)) Then
MsgBox "Please ender valid Gram", vbOKOnly + vbInformation, "Gram"
frm.Range("G10").Select
frm.Range("G10").Interior.Color = vbRed
Validate = False
Exit Function
End If
'Validating Quantity
If Trim(frm.Range("H10").Value) = "" Or Not IsNumeric(Trim(frm.Range("H10").Value)) Then
MsgBox "Please ender valid Quantity", vbOKOnly + vbInformation, "Quantity"
frm.Range("H10").Select
frm.Range("H10").Interior.Color = vbRed
Validate = False
Exit Function
End If
'Validating Size
If Trim(frm.Range("I10").Value) = "" Or Not IsNumeric(Trim(frm.Range("I10").Value)) Then
MsgBox "Please ender valid Size", vbOKOnly + vbInformation, "Quantity"
frm.Range("I10").Select
frm.Range("I10").Interior.Color = vbRed
Validate = False
Exit Function
End If
'Validating Weight
If Trim(frm.Range("J10").Value) = "" Or Not IsNumeric(Trim(frm.Range("J10").Value)) Then
MsgBox "Please ender valid Weight", vbOKOnly + vbInformation, "Weight"
frm.Range("J10").Select
frm.Range("J10").Interior.Color = vbRed
Validate = False
Exit Function
End If
'Validating Rate
If Trim(frm.Range("K10").Value) = "" Or Not IsNumeric(Trim(frm.Range("K10").Value)) Then
MsgBox "Please ender valid Rate", vbOKOnly + vbInformation, "Rate"
frm.Range("K10").Select
frm.Range("K10").Interior.Color = vbRed
Validate = False
Exit Function
End If
'Validating Vehicle No.
If Trim(frm.Range("I35").Value) = "" Then
MsgBox "Vehicle No. is blank", vbOKOnly + vbInformation, "Vehicle No."
frm.Range("I35").Select
frm.Range("I35").Interior.Color = vbRed
Validate = False
Exit Function
End If
'Validating Driver Name
If Trim(frm.Range("I36").Value) = "" Then
MsgBox "Driver Name is blank", vbOKOnly + vbInformation, "Driver Name"
frm.Range("I36").Select
frm.Range("I36").Interior.Color = vbRed
Validate = False
Exit Function
End If
'Validating Carrtage
If Trim(frm.Range("L35").Value) = "" Then
MsgBox "Cartage is blank if no charges put zero", vbOKOnly + vbInformation, "Cartage"
frm.Range("L35").Select
frm.Range("L35").Interior.Color = vbRed
Validate = False
Exit Function
End If
End Function
Sub Reset()
With Sheets("Form")
.Range("G5").Interior.Color = xlNone
.Range("G5").Value = ""
.Range("K5").Interior.Color = xlNone
.Range("K5").Value = ""
.Range("K7").Interior.Color = xlNone
.Range("K7").Value = ""
.Range("E10:E24").Interior.Color = xlNone
.Range("E10:E24").Value = ""
.Range("G10").Interior.Color = xlNone
.Range("G10").Value = ""
.Range("H10").Interior.Color = xlNone
.Range("H10").Value = ""
.Range("I10").Interior.Color = xlNone
.Range("I10").Value = ""
.Range("J10").Interior.Color = xlNone
.Range("J10").Value = ""
.Range("K10").Interior.Color = xlNone
.Range("K10").Value = ""
.Range("I35").Interior.Color = xlNone
.Range("I35").Value = ""
.Range("I36").Interior.Color = xlNone
.Range("I36").Value = ""
.Range("L35").Interior.Color = xlNone
.Range("L35").Value = ""
End With
End Sub
Sub Save()
Dim frm As Worksheet
Dim database As Worksheet
Dim iRow As Long
Dim iSerial As Long
Set frm = ThisWorkbook.Sheets("Form")
Set database = ThisWorkbook.Sheets("Database")
If Trim(frm.Range("L1").Value) = "" Then
iRow = database.Range("A" & Application.Rows.Count).End(xlUp).Row + 1
If iRow = 2 Then
iSerial = 1
Else
iSerial = database.Cells(iRow - 1, 1).Value + 1
End If
Else
iRow = frm.Range("K1").Value
iSerial = frm.Range("L1").Value
End If
With database
.Cells(iRow, 1).Value = iSerial
.Cells(iRow, 2).Value = frm.Range("G7").Value
.Cells(iRow, 3).Value = frm.Range("G5").Value
.Cells(iRow, 4).Value = frm.Range("K5").Value
.Cells(iRow, 5).Value = frm.Range("K7").Value
.Cells(iRow, 6).Value = frm.Range("E10:E24").Value
.Cells(iRow, 7).Value = frm.Range("G10").Value
.Cells(iRow, 8).Value = frm.Range("H10").Value
.Cells(iRow, 9).Value = frm.Range("I10").Value
.Cells(iRow, 10).Value = frm.Range("J10").Value
.Cells(iRow, 11).Value = frm.Range("K10").Value
.Cells(iRow, 12).Value = frm.Range("L10").Value
.Cells(iRow, 13).Value = frm.Range("L35").Value
.Cells(iRow, 14).Value = frm.Range("I35").Value
.Cells(iRow, 15).Value = frm.Range("I36").Value
.Cells(iRow, 16).Value = Application.UserName
.Cells(iRow, 17).Value = [Text(Now(), "DD-MM-YYYY HH:MM:SS")]
End With
frm.Range("K1").Value = ""
frm.Range("L1").Value = ""
End Sub
Sub Modify()
Dim iRow As Long
Dim iSerial As Long
iSerial = Application.InputBox("Please enter Serial Number to make modification.", "Modify", , , , , , 1)
On Error Resume Next
iRow = Application.WorksheetFunction.IfError _
(Application.WorksheetFunction.Match(iSerial, Sheets("Database").Range("A:A"), 0), 0)
On Error GoTo 0
If iRow = 0 Then
MsgBox "No record found.", vbOKOnly + vbCritical, "No Record"
Exit Sub
End If
Sheets("Form").Range("K1").Value = iRow
Sheets("Form").Range("L1").Value = iSerial
Sheets("Form").Range("G5").Value = Sheets("Database").Cells(iRow, 3).Value
Sheets("Form").Range("K5").Value = Sheets("Database").Cells(iRow, 4).Value
Sheets("Form").Range("G7").Value = Sheets("Database").Cells(iRow, 2).Value
Sheets("Form").Range("K7").Value = Sheets("Database").Cells(iRow, 5).Value
Sheets("Form").Range("E10:E24").Value = Sheets("Database").Cells(iRow, 6).Value
Sheets("Form").Range("G10").Value = Sheets("Database").Cells(iRow, 7).Value
Sheets("Form").Range("H10").Value = Sheets("Database").Cells(iRow, 8).Value
Sheets("Form").Range("I10").Value = Sheets("Database").Cells(iRow, 9).Value
Sheets("Form").Range("J10").Value = Sheets("Database").Cells(iRow, 10).Value
Sheets("Form").Range("K10").Value = Sheets("Database").Cells(iRow, 11).Value
Sheets("Form").Range("L10").Value = Sheets("Database").Cells(iRow, 12).Value
Sheets("Form").Range("I35").Value = Sheets("Database").Cells(iRow, 13).Value
Sheets("Form").Range("I36").Value = Sheets("Database").Cells(iRow, 14).Value
End Sub
Sub DeleteRecord()
Dim iRow As Long
Dim iSerial As Long
iSerial = Application.InputBox("Please enter S.No. to delete the record.", "Delete", , , , , , 1)
On Error Resume Next
iRow = Application.WorksheetFunction.IfError _
(Application.WorksheetFunction.Match(iSerial, Sheets("Database").Range("A:A"), 0), 0)
On Error GoTo 0
If iRow = 0 Then
MsgBox "No record found.", vbOKOnly + vbCritical, "No Record"
Exit Sub
End If
Sheets("Database").Cells(iRow, 1).EntireRow.Delete shift:=xlUp
End Sub