VBA for Purchase entry form

Z

Zubair

Active Member
Joined
Jul 4, 2009
Messages
304
Office Version
  1. 2016
Platform
  1. Windows
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
DEFGHIJKL
2Purchase Data Entry Form
3
4
5Supplier NameInvoice/Bill No.
6
7Supplier No.22005Invoice Date
8
9S. No.Brand (Quality)GramQuantitySizeWeightRateAmount
101-
112-
123-
134-
145-
156-
167-
178-
189-
1910-
2011-
2112-
2213-
2314-
2415-
2516-
2617-
2718-
2819-
2920-
3021-
3122-
3223-
3324-
34Subtotal-
35Vehicle No.Cartage
36Driver NameTOTAL-
37
Form
Cell Formulas
RangeFormula
L10:L33L10=+J10*K10
L34L34=SUM(L10:L33)
L36L36=+L35+L34
Cells with Data Validation
CellAllowCriteria
G5:H5List='Supplier Details'!$B$4:$B$205
K7List='Supplier Details'!$M$4:$M$10595


Dashboard
Corrugated Carton Business Model test.xlsm
ABCDEFGHIJKLMNOPQ
1S. NoSupplier No.Supplier NameInvoice/Bill No.Invoice DateBrand (Quantity)GramQuantitySizeWeightRate Amount Cartage Vehicle No.Driver NameSubmitted BySubmitted On
2122005Supplier No.95100051/21/2022Dubai1101397506045,000500KZ1250Driver 10ZESSA-Click22-01-2022 15:00:35
3222005Supplier No.100100061/21/2022Gold1151368506555,250250KY1500Driver 15ZESSA-Click22-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
 
Sort by date Sort by votes
mumps said:
Although the first sheet describes the purpose of each of the other sheets, it is not helpful in describing how, when and the criteria for manipulating the data. It appears to me that you are requesting a much more sophisticated solution involving many sheets and large amounts of data which would involve much time and experience. My apologies, but I don't think that I have the time or experience to help any further. :( I think your request is more suitable to submit to this Forum's consulting service (cost involved) at this link: Consulting Services
Good luck with it.
Click to expand...
Hi mumps: your 1st answer on purchase is the structure for my project which helps me to build the remaining, Many thanks,
 
Upvote 0

Excel Facts

Shade all formula cells
To shade all formula cells: Home, Find & Select, Formulas to select all formulas. Then apply a light fill color.
You must log in or register to reply here.

Similar threads

T
  • Solved
I keep getting error message "member already exists in an object module from which this project module derives
Replies
4
Views
797
Skyybot
Skyybot
D
  • Question Question
Adding an image to a database
Replies
0
Views
406
doudy11
D
J
  • Question Question
Update Row on another sheet based on Cell Value
Replies
2
Views
898
jeremiah_j2k
J
E
  • Solved
Delete Rows using input box to multiple sheets
Replies
4
Views
412
Elle_mostlysunny
E
K
  • Question Question
VBA one form two separate databases
Replies
2
Views
1K
Askil
A

Forum statistics

Threads
1,223,886
Messages
6,175,196
Members
452,616
Latest member
intern444

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top