Copy double-clicked cell to next empty row in different sheet with each double-click

Hi

That code looks fine to me based on what you described. Can you please upload a copy of your workbook, including somewhere in the workbook showing me the result that you expect to see after this macro is run and what it is doing now. This will allow me to step through your code in the same context as you, just to make sure that I am getting the correct solution for you.

Thanks

Sure!

Attached is the workbook. Let me know if I can help clarify anything.

Product Catalogue - Test.xlsm

Hi,

Here is a working version of what I think you want. Please take a look at the changes I made to the VBA and see if it is what you are asking for.

Notes:
1. The vendor name is now in a named range called "VendorName" - this is important as it is being used in VBA
2. The cell that says "Shipping" is now in a named range called "Shipping" - this is important as it is being used in VBA
3. The formula that calculates the total value of the PO has changed now - this is important as the sum range is variable if you are constantly adding rows to the order form

Let me know if this is what you are after.

Thanks! That is exactly what I was looking for.

I am also curious as to how I could press a button (called "Save PO") on the Purchase Order sheet and have it take all the products in the Purchase Order and copy them to another sheet ("Orders Placed")

I understand most of the code needed to make this happen, but I don't understand how to copy the products from the PO given that the size of the sheet is changing depending on how many items were added.

Thanks again.

Hi again,

The following code can be inserted on a button click event to copy the product rows to a worksheet called "Orders Placed":

Dim i As Integer

For i = 15 To Sheet4.Range("Shipping").Row - 1
    If WorksheetFunction.Trim(Sheet4.Cells(i, 1).Value) <> "" Then
        Sheet4.Rows(i).EntireRow.Copy
        With Worksheets("Orders Placed")
            .Rows(.Cells(.Rows.Count, 1).End(xlUp).Row + 1).Insert Shift:=xlDown
        End With
    Else
        Exit For
    End If
Next i

It is important to note that I have only given you enough code to copy these lines, as this was what you weren't sure about. I've left the formatting and other data copying up to you. This code also assumed that the required worksheet already exists, so you may want to perform a check first and if it doesn't exist, then have the VBA code create it for you, and then copy the headings across.

Once your purchase order has been saved, you could then call the following subroutine to reset the purchase order back to its original state:

Private Sub ResetPO()
    Dim i As Integer
    
    If Sheet4.Range("Shipping").Row > 19 Then
        For i = 19 To Sheet4.Range("Shipping").Row - 1
            Sheet4.Rows(i).EntireRow.Delete
        Next i
    End If
    
    Sheet4.Range("A15:J18").ClearContents
    
    Sheet4.Range("VendorName").ClearContents
End Sub

Hope this helps

Thanks again! This is all very helpful and informative!

I have one last issue: the sum that calculates the total doesn't seem to work if more than 4 products are added...

What formula do you have in the cell?

I changed it to the following so that it accommodates the insertion of rows above:

Formula:

=SUM(OFFSET($K$15,0,0,ROW($K$19)-ROW($K$15),1))+K19+K20

Let me know

I plugged that in and couldn't get it to work.

As a reminder I want to set the value of column K equal to the value of column A x column J. All the values in Column K are summed and added to shipping and tax to give the value of Total.

Sub PO_CalcTotal()
Range("K15").Select
    ActiveCell.FormulaR1C1 = "=RC[-1]*RC[-10]"
    Range("K15").Select
    Selection.AutoFill Destination:=Range("K15:K18"), Type:=xlFillDefault
    Range("K15:K18").Select
    ActiveWindow.SmallScroll Down:=6
    Range("K21").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-6]C:R[-3]C)+R[-2]C+R[-1]C"
    Range("F22:K22").Select
    ActiveWindow.SmallScroll Down:=-18
End Sub

What do you think is wrong? Thanks!

Ah sorry about the misunderstanding, I thought the "TOTAL" cell was giving you the wrong value, I didn't realise that you were referring to the "Calculate Total" button.

In that case, change the subroutine to reset the purchase order (if you decided to use it) to

Private Sub ResetPO()
    Dim i As Integer
    
    If Sheet4.Range("Shipping").Row > 19 Then
        For i = 19 To Sheet4.Range("Shipping").Row - 1
            Sheet4.Rows(i).EntireRow.Delete
        Next i
    End If
    
    Sheet4.Range("A15:K18").ClearContents
    
    Sheet4.Range("VendorName").ClearContents
End Sub

and change the Calculate Total subroutine to

Sub PO_CalcTotal()
    Dim i As Long
    
    For i = 15 To Sheet4.Range("Shipping").Row - 1
        Sheet4.Cells(i, 11).Formula = "=A" & i & "*J" & i
    Next i
    
    Sheet4.Cells(Sheet4.Range("VendorName").Row - 1, 11).Formula = "=SUM(K15:K" & Sheet4.Range("VendorName").Row - 2 & ")"
End Sub

Hope this works now

Ah great. Thanks! It works perfectly now.

I have another question:
I am trying to create radio buttons that control whether the double click event is capable of occurring. I've created the radio button code:

Public Sub SetOptionButtonStates()

Dim PAL_Create As Boolean
Dim PO_Create As Boolean
PAL_Create = False
PO_Create = False

End Sub
Sub OptionButton3_Click()


PO_Create = True
PAL_Create = False

End Sub
Sub OptionButton5_Click()

PAL_Create = True
PO_Create = False


End Sub

And I have nested an If statement in the beforedoubleclick event sub:

Public Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    'Override the default double-click behavior with this function.
    
    Cancel = False
    
   
    

    
    
 
    '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 PO_Create = True Then
        If Sheet4.Range("VendorName") = "" Then
        xRow = 15
        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.Range("VendorName") = Cells(seRow, seCol + 5) Then
            Dim i As Integer
            
            For i = 16 To Sheet4.Range("Shipping").Row
                If WorksheetFunction.Trim(Sheet4.Cells(i, 1).Value) = "" Then
                    xRow = i
                    Exit For
                End If
            Next i
            
            If i = Sheet4.Range("Shipping").Row Then
                Sheet4.Rows(Sheet4.Range("Shipping").Row - 1).EntireRow.Copy
                Sheet4.Rows(Sheet4.Range("Shipping").Row).Insert Shift:=xlDown
                Application.CutCopyMode = False
            End If
            
            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 If
    End Sub

But now the feature of adding a product by double-clicking doesn't work. I can't figure this out...

Hi, that's good to hear.

Could you please upload an updated version of your workbook with the radio buttons for me to have a look?

Thanks