VBA for Purchase entry form

[Zubair]

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

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

 

[mumps]

In the Form sheet, do you want to force entry of data in G5, G7, K5 and K7 and in E10:K33 for all brands entered in column E?

 

[Zubair]

not sure about force entry

G5 is the list of suppliers appearing through the dropdown box users need to select from this list.
G7 is appearing automatically based on G5 selection.
K5 user will put while looking the physical bill number which will be unique for each supplier.
K7 based on invoice
Column E also having dropdown list of products user need to select.
G10 to K10 user will put data from supplier invoice, may be only I10 having a limit from 20 inch to 50 inch will apply data validation, list later.
In some cases supplier may billed more than 1 brand so main requirement is to move more than 1 lines in the dashboard.

 

[mumps]

I have modified you approach somewhat and added some buttons on your sheet. Each button is assigned to the corresponding macro that I listed below. You would have to add similar buttons to your sheet and assign each one to the appropriate macro.

Sub SaveData()
    Application.ScreenUpdating = False
    Dim LastRow As Long, srcWS As Worksheet, desWS As Worksheet, brand As Range
    Set srcWS = Sheets("Form")
    Set desWS = Sheets("Database")
    LastRow = Range("E" & Rows.Count).End(xlUp).Row
    With srcWS
        LastRow = .Range("E" & .Rows.Count).End(xlUp).Row
        For Each brand In .Range("E10:E" & LastRow)
            desWS.Cells(desWS.Rows.Count, "B").End(xlUp).Offset(1).Resize(, 4).Value = Array(.Range("G7"), .Range("G5"), .Range("K5"), .Range("K7"))
            desWS.Cells(desWS.Rows.Count, "A").End(xlUp).Offset(1).Value = .Range("D" & brand.Row)
            desWS.Cells(desWS.Rows.Count, "F").End(xlUp).Offset(1).Value = .Range("E" & brand.Row)
            desWS.Cells(desWS.Rows.Count, "G").End(xlUp).Offset(1).Resize(, 6).Value = .Range("G" & brand.Row).Resize(, 6).Value
            desWS.Cells(desWS.Rows.Count, "M").End(xlUp).Offset(1).Resize(, 5).Value = Array(.Range("L35"), .Range("I35"), .Range("I36"), Application.UserName, [Text(Now(), "DD-MM-YYYY HH:MM:SS")])
        Next brand
    End With
    Application.ScreenUpdating = True
End Sub

Sub EditData()
    Application.ScreenUpdating = False
    Dim srcWS As Worksheet, desWS As Worksheet
    Set srcWS = Sheets("Form")
    Set desWS = Sheets("Database")
    x = Application.InputBox("Please enter Serial Number to make modification.", "Modify", , , , , , 1)
    Set fnd = desWS.Range("A:A").Find(x, LookIn:=xlValues, lookat:=xlWhole)
    If Not fnd Is Nothing Then
        With srcWS
            .Range("G5").Value = fnd.Offset(, 2)
            .Range("K5").Value = fnd.Offset(, 3)
            .Range("G7").Value = fnd.Offset(, 1)
            .Range("K7").Value = fnd.Offset(, 4)
            .Range("E10:K33").ClearContents
            .Range("E10:E33") = fnd.Offset(, 5)
            .Range("G10").Resize(, 6).Value = Array(fnd.Offset(, 6), fnd.Offset(, 7), fnd.Offset(, 8), fnd.Offset(, 9), fnd.Offset(, 10), fnd.Offset(, 11))
        End With
    Else
        MsgBox "No record found.", vbOKOnly + vbCritical, "No Record"
    End If
    Application.ScreenUpdating = True
End Sub

Sub Reset()
    Application.ScreenUpdating = False
    Dim srcWS As Worksheet, desWS As Worksheet
    Set srcWS = Sheets("Form")
    Set desWS = Sheets("Database")
    With srcWS
        .Range("G5,G7,K5,K7").Interior.Color = xlNone
        .Range("G5,G7,K5,K7").Value = ""
        .Range("E10:K33").Interior.Color = xlNone
        .Range("E10:K33").Value = ""
        .Range("I35:I36,L35:L36").Interior.Color = xlNone
        .Range("I35:I36,L35:L36").Value = ""
    End With
    Application.ScreenUpdating = True
End Sub

Sub DeleteRecord()
    Application.ScreenUpdating = False
    Dim x As String
    x = Application.InputBox("Please enter S.No. to delete the record.", "Delete", , , , , , 1)
    Set fnd = Sheets("Database").Range("A:A").Find(x, LookIn:=xlValues, lookat:=xlWhole)
    If Not fnd Is Nothing Then
        Sheets("Database").Rows(fnd.Row).Delete
    Else
        MsgBox "No record found.", vbOKOnly + vbCritical, "No Record"
    End If
    Application.ScreenUpdating = True
End Sub

Sub CheckData()
    Dim frm As Worksheet
    Set frm = Sheets("Form")
    With frm
        .Range("G5,K5,K7,E10:K33,I35:I36,L35").Interior.Color = xlNone
        If Trim(.Range("G5").Value) = "" Then
            MsgBox "Supplier Name is blank.", vbOKOnly + vbInformation, "Supplier Name"
            .Range("G5").Interior.Color = vbRed
            Exit Sub
        End If
        If Trim(.Range("K5").Value) = "" Then
            MsgBox "Invoice/Bill No. is blank.", vbOKOnly + vbInformation, "Invoice/Bill No."
            .Range("K5").Interior.Color = vbRed
            Exit Sub
        End If
        If Trim(.Range("K7").Value) = "" Then
        MsgBox "Invoice Date is blank", vbOKOnly + vbInformation, "Invoice Date"
            .Range("K7").Interior.Color = vbRed
            Exit Sub
        End If
        If Trim(.Range("E10").Value) = "" Then
            MsgBox "Quality is blank", vbOKOnly + vbInformation, "Brand (Quality)"
            frm.Range("E10").Interior.Color = vbRed
            Exit Sub
        End If
        If Trim(.Range("G10").Value) = "" Or Not IsNumeric(Trim(frm.Range("G10").Value)) Then
            MsgBox "Please ender valid Gram", vbOKOnly + vbInformation, "Gram"
            .Range("G10").Interior.Color = vbRed
            Exit Sub
        End If
        If Trim(.Range("H10").Value) = "" Or Not IsNumeric(Trim(frm.Range("H10").Value)) Then
            MsgBox "Please ender valid Quantity", vbOKOnly + vbInformation, "Quantity"
            .Range("H10").Interior.Color = vbRed
            Exit Sub
        End If
        If Trim(.Range("I10").Value) = "" Or Not IsNumeric(Trim(frm.Range("I10").Value)) Then
            MsgBox "Please ender valid Size", vbOKOnly + vbInformation, "Quantity"
            .Range("I10").Interior.Color = vbRed
            Exit Sub
        End If
        If Trim(.Range("J10").Value) = "" Or Not IsNumeric(Trim(frm.Range("J10").Value)) Then
            MsgBox "Please ender valid Weight", vbOKOnly + vbInformation, "Weight"
            .Range("J10").Interior.Color = vbRed
            Exit Sub
        End If
        If Trim(.Range("K10").Value) = "" Or Not IsNumeric(Trim(frm.Range("K10").Value)) Then
            MsgBox "Please ender valid Rate", vbOKOnly + vbInformation, "Rate"
            .Range("K10").Interior.Color = vbRed
            Exit Sub
        End If
        If Trim(.Range("I35").Value) = "" Then
            MsgBox "Vehicle No. is blank", vbOKOnly + vbInformation, "Vehicle No."
            .Range("I35").Interior.Color = vbRed
            Exit Sub
        End If
        If Trim(.Range("I36").Value) = "" Then
            MsgBox "Driver Name is blank", vbOKOnly + vbInformation, "Driver Name"
            .Range("I36").Interior.Color = vbRed
            Exit Sub
        End If
        If Trim(.Range("L35").Value) = "" Then
            MsgBox "Cartage is blank if no charges put zero", vbOKOnly + vbInformation, "Cartage"
            .Range("L35").Interior.Color = vbRed
            Exit Sub
        End If
    End With
End Sub

This is what your sheet would look like.

Zubair.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O
1
2				Purchase Data Entry Form
3
4
5					Supplier Name					Invoice/Bill No.
6
7					Supplier No.					Invoice Date
8
9				S. No.	Brand (Quality)		Gram	Quantity	Size	Weight	Rate	Amount
10				1								0
11				2								0
12				3								0
13				4								0
14				5								0
15				6								0
16				7								0
17				8								0
18				9								0
19				10								0
20				11								0
21				12								0
22				13								0
23				14								0
24				15								0
25				16								0
26				17								0
27				18								0
28				19								0
29				20								0
30				21								0
31				22								0
32				23								0
33				24								0
34											Subtotal	0
35								Vehicle No.			Cartage
36								Driver Name			TOTAL
Form

 

[Zubair]

Many thanks for the help, please provide further guidance as follows:

1 which button to add and where?
2 where to paste VBA in Module 1 or Form?
3 shall in need to create new file

 

[mumps]

For clarification: Will you be deleting or modifying the data one row at a time or all the rows based on a particular Supplier Number? Also, will the Database sheet contain all purchase data for all Supplier Numbers or will the database be cleared each time a new supplier number is added so that it will contain only one supplier number at a time?

 

[Zubair]

If possible it will be go if I can get both options of delete or modify data, if not then more important to delete or modify based on the Invoice number.

Regarding the Database sheet, it should contain all purchase data for all suppliers.

 

[mumps]

After you modify any data, do you want to save the modifications to the database replacing the old values with the modified ones?

 

[Zubair]

Yes

 

[mumps]

Click here to download your file. The buttons on the Form sheet are linked to the corresponding macros. All you have to do is click. Notice that there are two "Save" buttons. The first saves data that is new and does not exist in the database. The second saves any changes you make after you click the Edit button and make the changes. If in the editing you add a new row of data that doesn't exist in the database, it will be added to the first available row in the database. I have used cell AA1 in the Form sheet as a helper cell. Since there currently is no data in the Form, the value in AA1 = 1. This is the starting number for the serial numbers. When you start entering data in column E of the form and press the TAB key to move to column G, the serial number will automatically be placed in column D and the value in AA1 will be incremented by 1 which will be used for the next brand entered. If you re-set the form to start a new invoice, the serial numbers will continue from the last one used previously when you start entering the brands. This will make sure that the serial numbers in the database will always be unique. They must be unique in order for the modification and delete macros to work properly. The form does not contain any drop down lists so you will have to add them in the appropriate cells. Give it a try and see how it works. This macro that inserts the serial number, is in the code module for the Form sheet.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    If Intersect(Target, Range("E:E")) Is Nothing Then Exit Sub
    Target.Offset(, -1) = Range("AA1")
    Range("AA1") = Range("AA1") + 1
End Sub

To view it, right click the tab name for your Form sheet and click 'View Code'. A window showing the macro will be displayed. Close the code window to return to your sheet. The following macros are in Module1:

Sub SaveNewData()
    Application.ScreenUpdating = False
    Dim LastRow As Long, srcWS As Worksheet, desWS As Worksheet, brand As Range
    Set srcWS = Sheets("Form")
    Set desWS = Sheets("Database")
    With srcWS
        LastRow = .Range("E" & .Rows.Count).End(xlUp).Row
        For Each brand In .Range("E10:E" & LastRow)
            desWS.Cells(desWS.Rows.Count, "B").End(xlUp).Offset(1).Resize(, 4).Value = Array(.Range("G7"), .Range("G5"), .Range("K5"), .Range("K7"))
            desWS.Cells(desWS.Rows.Count, "A").End(xlUp).Offset(1).Value = .Range("D" & brand.Row)
            desWS.Cells(desWS.Rows.Count, "F").End(xlUp).Offset(1).Value = .Range("E" & brand.Row)
            desWS.Cells(desWS.Rows.Count, "G").End(xlUp).Offset(1).Resize(, 6).Value = .Range("G" & brand.Row).Resize(, 6).Value
            desWS.Cells(desWS.Rows.Count, "M").End(xlUp).Offset(1).Resize(, 5).Value = Array(.Range("L35"), .Range("I35"), .Range("I36"), Application.UserName, [Text(Now(), "DD-MM-YYYY HH:MM:SS")])
        Next brand
    End With
    Application.ScreenUpdating = True
End Sub

Sub SaveModData()
    Application.ScreenUpdating = False
    Dim LastRow As Long, srcWS As Worksheet, desWS As Worksheet, SN As Range, fndSN As Range
    Set srcWS = Sheets("Form")
    Set desWS = Sheets("Database")
    With srcWS
        LastRow = .Range("D" & .Rows.Count).End(xlUp).Row
        For Each SN In .Range("D10:D" & LastRow)
            Set fndSN = desWS.Range("A:A").Find(SN, LookIn:=xlValues, lookat:=xlWhole)
            If Not fndSN Is Nothing Then
                With desWS
                    fndSN.Offset(, 1).Resize(, 4).Value = Array(Range("G7").Value, Range("G5").Value, Range("K5").Value, Range("K7").Value)
                    fndSN.Offset(, 5).Resize(, 6).Value = Array(Range("E" & SN.Row).Value, Range("G" & SN.Row).Value, Range("H" & SN.Row).Value, Range("I" & SN.Row).Value, Range("J" & SN.Row).Value, Range("K" & SN.Row).Value)
                End With
            Else
                With desWS
                    .Cells(.Rows.Count, "A").End(xlUp).Offset(1).Value = SN
                    .Cells(.Rows.Count, "B").End(xlUp).Offset(1).Resize(, 4).Value = Array(Range("G7"), Range("G5"), Range("K5"), Range("K7"))
                    .Cells(.Rows.Count, "F").End(xlUp).Offset(1).Value = Range("E" & SN.Row)
                    .Cells(.Rows.Count, "G").End(xlUp).Offset(1).Resize(, 6).Value = Range("G" & SN.Row).Resize(, 6).Value
                    .Cells(.Rows.Count, "M").End(xlUp).Offset(1).Resize(, 5).Value = Array(Range("L35"), Range("I35"), Range("I36"), Application.UserName, [Text(Now(), "DD-MM-YYYY HH:MM:SS")])
                End With
            End If
        Next SN
    End With
    Application.ScreenUpdating = True
End Sub

Sub EditData()
    Application.ScreenUpdating = False
    Dim srcWS As Worksheet, desWS As Worksheet, INV As String, RowCount As Long, fVisRow As Long, lVisRow As Long
    Set srcWS = Sheets("Form")
    Set desWS = Sheets("Database")
    INV = Application.InputBox("Please enter Invoice No. you wish to modify.", "Modify", , , , , , 1)
    Set fnd = desWS.Range("D:D").Find(INV, LookIn:=xlValues, lookat:=xlWhole)
    If Not fnd Is Nothing Then
        With desWS
            .Range("A1").CurrentRegion.AutoFilter 4, INV
            fVisRow = .AutoFilter.Range.Offset(1, 0).SpecialCells(xlCellTypeVisible).Cells(1, 1).Row
            lVisRow = .Cells(.Rows.Count, "A").End(xlUp).Row
            RowCount = .[subtotal(103,A:A)] - 1
            With srcWS
                .Range("G5").Value = fnd.Offset(, -1)
                .Range("K5").Value = INV
                .Range("G7").Value = fnd.Offset(, -2)
                .Range("K7").Value = fnd.Offset(, 1)
                .Range("E10:K33").ClearContents
                .Range("D10").Resize(RowCount).Value = desWS.Range("A" & fVisRow).Resize(2).Value
                .Range("E10").Resize(RowCount).Value = desWS.Range("F" & fVisRow).Resize(2).Value
                .Range("G10").Resize(RowCount, 5).Value = desWS.Range("G" & fVisRow).Resize(RowCount, 5).Value
            End With
            .Range("A1").AutoFilter
        End With
    Else
        MsgBox "No record found.", vbOKOnly + vbCritical, "No Record"
    End If
    Application.ScreenUpdating = True
End Sub

Sub Reset()
    Application.ScreenUpdating = False
    Dim srcWS As Worksheet, desWS As Worksheet
    Set srcWS = Sheets("Form")
    Set desWS = Sheets("Database")
    With srcWS
        .Range("G5,G7,K5,K7").Interior.Color = xlNone
        .Range("G5,G7,K5,K7").Value = ""
        .Range("D10:K33").Interior.Color = xlNone
        .Range("D10:K33").Value = ""
        .Range("I35:I36,L35:L36").Interior.Color = xlNone
        .Range("I35:I36,L35:L36").Value = ""
    End With
    Application.ScreenUpdating = True
End Sub

Sub DeleteRecord()
    Application.ScreenUpdating = False
    Dim INV As String
    INV = Application.InputBox("Please enter the Invoice No. to delete.", "Delete", , , , , , 1)
    If MsgBox("Are you sure you want to permanently delete all the records" & Chr(10) & "for Supplier No. " & SN & "?", vbYesNo) = vbYes Then
        Set fnd = Sheets("Database").Range("D:D").Find(INV, LookIn:=xlValues, lookat:=xlWhole)
        If Not fnd Is Nothing Then
            With Sheets("Database")
                .Range("A1").CurrentRegion.AutoFilter 4, INV
                .AutoFilter.Range.Offset(1).EntireRow.Delete
                .Range("A1").AutoFilter
            End With
        Else
            MsgBox "No record found.", vbOKOnly + vbCritical, "No Record"
        End If
    Else
        MsgBox ("No records were deleted.")
    End If
    Application.ScreenUpdating = True
End Sub

Sub CheckData()
    Dim frm As Worksheet
    Set frm = Sheets("Form")
    With frm
        .Range("G5,K5,K7,E10:K33,I35:I36,L35").Interior.Color = xlNone
        If Trim(.Range("G5").Value) = "" Then
            MsgBox "Supplier Name is blank.", vbOKOnly + vbInformation, "Supplier Name"
            .Range("G5").Interior.Color = vbRed
            Exit Sub
        End If
        If Trim(.Range("K5").Value) = "" Then
            MsgBox "Invoice/Bill No. is blank.", vbOKOnly + vbInformation, "Invoice/Bill No."
            .Range("K5").Interior.Color = vbRed
            Exit Sub
        End If
        If Trim(.Range("K7").Value) = "" Then
        MsgBox "Invoice Date is blank", vbOKOnly + vbInformation, "Invoice Date"
            .Range("K7").Interior.Color = vbRed
            Exit Sub
        End If
        If Trim(.Range("E10").Value) = "" Then
            MsgBox "Quality is blank", vbOKOnly + vbInformation, "Brand (Quality)"
            frm.Range("E10").Interior.Color = vbRed
            Exit Sub
        End If
        If Trim(.Range("G10").Value) = "" Or Not IsNumeric(Trim(frm.Range("G10").Value)) Then
            MsgBox "Please ender valid Gram", vbOKOnly + vbInformation, "Gram"
            .Range("G10").Interior.Color = vbRed
            Exit Sub
        End If
        If Trim(.Range("H10").Value) = "" Or Not IsNumeric(Trim(frm.Range("H10").Value)) Then
            MsgBox "Please ender valid Quantity", vbOKOnly + vbInformation, "Quantity"
            .Range("H10").Interior.Color = vbRed
            Exit Sub
        End If
        If Trim(.Range("I10").Value) = "" Or Not IsNumeric(Trim(frm.Range("I10").Value)) Then
            MsgBox "Please ender valid Size", vbOKOnly + vbInformation, "Quantity"
            .Range("I10").Interior.Color = vbRed
            Exit Sub
        End If
        If Trim(.Range("J10").Value) = "" Or Not IsNumeric(Trim(frm.Range("J10").Value)) Then
            MsgBox "Please ender valid Weight", vbOKOnly + vbInformation, "Weight"
            .Range("J10").Interior.Color = vbRed
            Exit Sub
        End If
        If Trim(.Range("K10").Value) = "" Or Not IsNumeric(Trim(frm.Range("K10").Value)) Then
            MsgBox "Please ender valid Rate", vbOKOnly + vbInformation, "Rate"
            .Range("K10").Interior.Color = vbRed
            Exit Sub
        End If
        If Trim(.Range("I35").Value) = "" Then
            MsgBox "Vehicle No. is blank", vbOKOnly + vbInformation, "Vehicle No."
            .Range("I35").Interior.Color = vbRed
            Exit Sub
        End If
        If Trim(.Range("I36").Value) = "" Then
            MsgBox "Driver Name is blank", vbOKOnly + vbInformation, "Driver Name"
            .Range("I36").Interior.Color = vbRed
            Exit Sub
        End If
        If Trim(.Range("L35").Value) = "" Then
            MsgBox "Cartage is blank if no charges put zero", vbOKOnly + vbInformation, "Cartage"
            .Range("L35").Interior.Color = vbRed
            Exit Sub
        End If
    End With
End Sub