{Excel} Multiple command buttons to email different rows

Question

I am setting up a new spreadsheet that logs problems with items the warehouse has tried to book to stock. each row contains the material number, description , QTY, the supplier, and the persons email who owns suppliers account.

When the warehouse team input the relevant data in worksheet, I want there to be a button at the end of each row that when pressed it will email the persons email who owns the suppliers account the entire row the button is on (A2:O2) for button one, (A3:O3) for button two and so on. there would be at least 2000 rows that will need this.

Now i have written the VBA code that is capable of doing this (I admit it is a really ugly way of making the row and headers line up), but only for the first row. I would be able to do it for 2000 rows but it means making 2000 buttons and changing the VBA code 2000 time only to change the row of cells.

Is there any alternative way I can complete my desired automatic email when the team populate a new row?

'''

Private Sub Worksheet_BeforeDoubleClick

(ByVal Target As Range, Cancel As Boolean)

If Not Intersect(Target, Range("O2:O10000")) Is Nothing Then [P2: P10000]

Dim xOutApp As Object

Dim xOutMail As Object

Dim xMailBody As String


On Error Resume Next

Set xOutApp = CreateObject("Outlook.Application")

Set xOutMail = xOutApp.CreateItem(0)

xMailBody = [A1] & "               " & [B1] & "                    " & [c1] & "                  " & [d1] & "                  " & [e1] & "                  " & [G1] & "                   " & [H1] & "                        " & [J1] & "                                               " & [L1] & vbNewLine & "          " & [A2] & "                           " & [B2] & "                     " & [c2] & "                      " & [d2] & "                               " & [e2] & "                                " & [G2] & "                                              " & [H2] & "                                      " & [J2] & "                      " & [L2]

On Error Resume Next

With xOutMail

    .To = [O2]

    .CC = ""

    .BCC = ""

    .Subject = "NEW MATERIAL ADDED TO 2200 LIST"

    .Body = xMailBody

    .send   'or use .Send

End With

On Error GoTo 0

Set xOutMail = Nothing

Set xOutApp = Nothing

End Sub

Luis Curado Luis Curado · Accepted Answer · 2019-04-12T14:50:54

instead a button u can use double click on a cell.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Not Intersect(Target, Range("B6:B10000")) Is Nothing Then ' cells where u want to double click


    ' your code
    ' call your sub or function
    End If
End Sub

you can put a symbol in this cells like a square or something (use the Webdings font), and when the user double click on thant cell u get the address (Target) and send it to yor sub.

good luck

Updade:

u have to create a variable with the line number using target.row,like this

.....

If Not Intersect(Target, Range("O2:O10000")) Is Nothing Then [P2: P10000]

   lineNumber=target.row

Dim xO

....

and then u have to refer the cells with this variable. I believe that with short referencing u cant put a variable, so you have to change it to range, like

change [A2] to range("A" & lineNumber)

change [B2] to range("B" & lineNumber)

etc

good luck

{Excel} Multiple command buttons to email different rows

1 Answers