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
Hi mumps, Excellent, many thanks,

as instructed I have downloaded and run and found it according to my need, just wonder if the following are not appearing in Dashboard.

Driver Name, Vehicle No. & Cartage
It's not stopping or putting red when any field in Form is missing.
While putting more than 1 brand supplier no. and the name is appearing blank in Dashboard which is logical, but it will be good if it can repeat the same
 
Upvote 0

Excel Facts

How to total the visible cells?
From the first blank cell below a filtered data set, press Alt+=. Instead of SUM, you will get SUBTOTAL(9,)
if person wrongly press botton "Save New" twice the entry is generating in Dashboard, better after save all fields should be blank for next entry
 
Upvote 0
Zubair said:
It's not stopping or putting red when any field in Form is missing.
Click to expand...
I'm not sure why this part is not working for you. It works properly for me when I test the macro. Are you using the macros in the file I posted or in a different file?

Replace these 3 macros with the ones below:
VBA Code: 
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
        For Each brand In .Range("E10", .Range("E" & .Rows.Count).End(xlUp))
            LastRow = desWS.Range("E" & .Rows.Count).End(xlUp).Row + 1
            desWS.Range("A" & LastRow).Value = .Range("D" & brand.Row)
            desWS.Range("B" & LastRow).Resize(, 4).Value = Array(.Range("G7"), .Range("G5"), .Range("K5"), .Range("K7"))
            desWS.Range("F" & LastRow).Value = .Range("E" & brand.Row)
            desWS.Range("G" & LastRow).Resize(, 6).Value = .Range("G" & brand.Row).Resize(, 6).Value
            desWS.Range("M" & LastRow).Resize(, 5).Value = Array(.Range("L35"), .Range("I35"), .Range("I36"), Application.UserName, [Text(Now(), "DD-MM-YYYY HH:MM:SS")])
        Next brand
    End With
    Call Reset
    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
        For Each SN In .Range("D10", .Range("D" & .Rows.Count).End(xlUp))
            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(, 7).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, Range("L" & SN.Row).Value)
                    .Range("M" & fndSN.Row).Resize(, 5).Value = Array(Range("L35"), Range("I35"), Range("I36"), Application.UserName, [Text(Now(), "DD-MM-YYYY HH:MM:SS")])
                End With
            Else
                With desWS
                    LastRow = .Range("D" & .Rows.Count).End(xlUp).Row + 1
                    .Range("A" & LastRow).Value = SN
                    .Range("B" & LastRow).Resize(, 4).Value = Array(Range("G7"), Range("G5"), Range("K5"), Range("K7"))
                    .Range("F" & LastRow).Value = Range("E" & SN.Row)
                    .Range("G" & LastRow).Resize(, 6).Value = Range("G" & SN.Row).Resize(, 6).Value
                    .Range("M" & LastRow).Resize(, 5).Value = Array(Range("L35"), Range("I35"), Range("I36"), Application.UserName, [Text(Now(), "DD-MM-YYYY HH:MM:SS")])
                    .Range("N" & LastRow) = Range("I35")
                    .Range("O" & LastRow) = Range("I36")
                    .Range("M" & LastRow) = Range("L35")
                End With
            End If
        Next SN
    End With
    Call Reset
    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("D10:K33").ClearContents
                .Range("D10").Resize(RowCount).Value = desWS.Range("A" & fVisRow).Resize(RowCount).Value
                .Range("E10").Resize(RowCount).Value = desWS.Range("F" & fVisRow).Resize(RowCount).Value
                .Range("G10").Resize(RowCount, 5).Value = desWS.Range("G" & fVisRow).Resize(RowCount, 5).Value
                .Range("I35") = desWS.Range("N" & fVisRow)
                .Range("I36") = desWS.Range("O" & fVisRow)
                .Range("L35") = desWS.Range("M" & fVisRow)
            End With
            .Range("A1").AutoFilter
        End With
    Else
        MsgBox "No record found.", vbOKOnly + vbCritical, "No Record"
    End If
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
Solution
Yes its working perfectly, many thanks.

As I mentioned purchase is the part of Inventory management, 2nd part is production, will ask your help till the whole project will be completed.

Hope you will support.

Thanks again.
 
Upvote 0
Now 2nd phase going to start I have added/changed the following tabs.

Changed tab from Form to Purchase
Added
1. Production
2. Sales
3. Stock Adjustment
4. Voucher
5. Reel stock
6. Accounts Receivable
7. Accounts Payable
8. Setup

Not known how to add excel file please guide
 
Upvote 0
You could use the XL2BB add-in (icon in the menu) to attach screenshots (not a pictures) of your sheets. Alternately, you could upload a copy of your file to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. Explain in detail what you want to do referring to specific cells, rows, columns and sheets using a few examples from your data (de-sensitized if necessary).
 
Upvote 0
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.
 
Upvote 0
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
477
Skyybot
Skyybot
D
  • Question
Adding an image to a database
Replies
0
Views
312
doudy11
D
J
  • Question
Update Row on another sheet based on Cell Value
Replies
2
Views
768
jeremiah_j2k
J
E
  • Solved
Delete Rows using input box to multiple sheets
Replies
4
Views
253
Elle_mostlysunny
E
K
  • Question
VBA one form two separate databases
Replies
2
Views
807
Askil
A

Forum statistics

Threads
1,215,045
Messages
6,122,836
Members
449,096
Latest member
Erald

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