I am trying to create an inventory system.
I have written code so that if you double click a product (Sheet1), it adds the relevant information about the product (columns 1,2,3, 9, 10) into the purchase order (Sheet 4).
I also have code so that it only adds a secondary product if it is from the same supplier (as seen by the value of Row 22, Column 6).
I need to find a way such that the first product double clicked is added to Row 15, Column 3 of Sheet 4. If another product is double-clicked a new row is inserted below row 15 in Sheet 4 and the relevant information is copied, etc...
Any help would be great!
This is what I have so far:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'Override the default double-click behavior with this function.
Cancel = True
'Declare variables.
Dim wks As Worksheet, xRow As Long
'If an error occurs, use inline error handling.
On Error Resume Next
'Capture double-clicked cell
Target.Select
'Capture double-clicked row
seRow = Target.Row
seCol = 0
'Insert in Row 15 of Sheet4
xRow = Sheet4.Cells(Sheet4.Rows.Count, 1).End(xlUp).Row + 1
'For first product added to purchase order
If Sheet4.Cells(22, 6) = "" Then
Sheet4.Cells(22, 6) = Cells(seRow, seCol + 5)
Sheet4.Cells(xRow, 3) = Cells(seRow, seCol + 2)
Sheet4.Cells(xRow, 9) = Cells(seRow, seCol + 6)
Sheet4.Cells(xRow, 10) = Cells(seRow, seCol + 9)
Sheet4.Cells(xRow, 1) = Cells(seRow, seCol + 7)
Sheet4.Cells(xRow, 2) = Cells(seRow, seCol + 8)
MsgBox "New Order Started: Producted Added to PO"
'If trying to add another product to purchase order, check to make sure the vendor is the same
Else
If Sheet4.Cells(22, 6) = Cells(seRow, seCol + 5) Then
Sheet4.Cells(xRow, 3) = Cells(seRow, seCol + 2)
Sheet4.Cells(xRow, 9) = Cells(seRow, seCol + 6)
Sheet4.Cells(xRow, 10) = Cells(seRow, seCol + 9)
Sheet4.Cells(xRow, 1) = Cells(seRow, seCol + 7)
Sheet4.Cells(xRow, 2) = Cells(seRow, seCol + 8)
MsgBox "Product Added to PO"
Else
MsgBox "This item is not from the same vendor"
End If
End If
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Bookmarks