Adding Email Function to Excel Search

Question

We have a trade show every year. I was using an web based sign in that would email our sales reps when one of their customers showed up. So i have a list of customers that have signed up for the trade show. I wanted to use this to check them in. So i made it searchable. Its only 5 columns, Ticket#, First Name, Last Name, Company Name, Sales Rep Email. I want to have a button i can click that would mark them "checked in", and send an email to the sales rep email in that cell, and make the subject a combo of the first name, last name and company name cells. Is any of this doable? Thanks in advance.

Answer 1

1.Here is sample assumed data as per question.

Ticket# First_  Last_   Company           Sales_Rep_Email   Status
        Name    Name    Name      
1001    James   Smith   Hana Toys          abc@gmail.com     
1002    Michael Smith   Alpha Marketing    bcd@gmail.com    
1003    Robert  Smith   Baj Finance        edf@gmail.com    
1004    Maria   Smith   Home Appliances    def@gmail.com    
1005    David   Smith   IkeaMart           fgi@gmail.com    
1006    Mary    Garcia  Fruit Beverages    abc@gmail.com     
1007    Raj     Kumar   ABC Consultants    bcd@gmail.com    
1008    Deepak  Tandon  Smith and Smith    edf@gmail.com    
1009    Hary    Smih    Veritas Limited    def@gmail.com     
1010    Arun    Sharma  Lovely Lingeries   fgi@gmail.com    

    "Note: Names and companies are fictitious and have no relevance to any name or company, if exists"

B. This data is searched and filtered as per status. Filtered data is in this form.

Ticket# First_  Last_   Company_    Sales_Rep_      Status
        Name    Name    Name        Email
1003    Robert  Smith   Baj Finance edf@gmail.com   yes
1005    David   Smith   IkeaMart    fgi@gmail.com   yes

C. A Form Control Command Button has been placed as shown in the snapshot and Macro Send_Email has been attached to it.

D. This code works for me.

  Sub Send_Email()
    Dim objOutlook As Object
    Dim objMail As Object
    Dim Recipients As String
    Dim CellReference As Integer
    Dim RowLimit As String
    Dim firstRow As Long
    Dim lastRow As Long
    Dim cell As Excel.Range
    Dim row As Long
    Dim substr As String


    Set objOutlook = CreateObject("Outlook.Application")
    Set objMail = objOutlook.CreateItem(0)

        CellReference = 5

      With ActiveSheet

        'Find the first and last index of the visible range.
        firstRow = .AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).row
        lastRow = .Cells(.Rows.Count, 1).End(xlUp).row


        'Loop through all the rows between [firstRow] and [lastRow] established before.

        For row = firstRow To lastRow

            Set cell = .Cells(row, CellReference)
            substr = .Cells(row, 2).Value & "  " & .Cells(row, 3).Value & " , " & .Cells(row, 4).Value
            'checking if the row is hidden or visible.

            If Not cell.EntireRow.Hidden Then

                'Concatenate Recipients

                Recipients = Recipients & cell.Value & ";"
            End If

        Next row

    End With


    With objMail
        .To = Recipients
        .Subject = substr
        .Body = "Please follow up this customer"
        '.Display    'Uncomment it ,if you want to review email
        .Send
    End With

    Set objOutlook = Nothing
    Set objMail = Nothing

End Sub