Results 1 to 3 of 3
  1. #1
    Bronze Lounger
    Join Date
    Feb 2008
    Thanked 12 Times in 12 Posts

    Double Cliicking on Names to Extract all data pertaining to particular Name


    I have a spreadsheet & I would like to be able to double click on a name on Column C and would like the following data extracted into Outlook

    The subject line must State Admin Comm

    1) Comm
    2) Branch Name for Eg BR1
    3) Amount

    I must be able to double click on a name and the above information must be extracted once for all unique names for eg if Peter Bythe appears more than once then all the information appearing in col B & D for Peter Blythe must be extracted for eg

    Comm Br1 6502
    Comm Br2 2996

    I have the folowing code in the sheet below as well as the following code in the module, but the Branch names & amounts are not being extracted into the body for eg

    CommBr1 6502
    Comm Br2 2996

    Your assistance will be most appreciated

    Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) 
        Dim r As Range, myName, zMailTo, zDate, zBranch, zAmount 
        If Target.Column <> 3 Then Exit Sub 
        Cancel = True 
        myName = Target.Value 
        For Each r In Columns(3).SpecialCells(2) 
            If r.Value = myName Then 
                If zMailTo = "" Then zMailTo = r(, 3).Value 
                zBranch = zBranch & ";" & r(, 0).Value 
                zamont = zAmount & vbCrLf & r(, 2).Text 
            End If 
        prepareEmail zMailTo, Date, Mid$(zBranch, 2), Mid$(zAmount, 3) 
    End Sub
    Public olApp As New Outlook.Application
    Public nsMAPI As Outlook.Namespace
    Public exp As Outlook.Explorer
    Sub prepareEmail(zMailTo, zDate, zBranch, zAmount)
    zMailAddress = zMailTo                      'e.g. ""
    zMonth = Format(CDate(zDate), "mmm-yyyy")   'e.g. "Feb-2012"
    zBranchName = zBranch                       'e.g. "Br2"
    zCommission = Format(zAmount, "#,###")      'e.g. 1,614
    On Error GoTo errorExit                     'set error trap for next lines..
    Dim itmMail As Outlook.MailItem             'define shortcut for dummy email
    Set nsMAPI = olApp.GetNamespace("MAPI")     'define shortcut for Outlook
    Set itmMail = olApp.CreateItem(olMailItem)  'define shortcut for creating email
    On Error GoTo 0                             'reset error trap
    Set itmMail = olApp.CreateItem(olMailItem)  'create email
    With itmMail                                'using email..
    .Display                                    'show email
    .To = zMailTo                               'put recipient in To field
    .Subject = zMonth & " Commission : " & zBranchName  'e.g. "Feb-2012 Commission : Br2"
    .Body = "Commission amount : " & zAmont        'e.g. "Commission amount : 1,614"
    End With
    Exit Sub
    End Sub
    Attached Files Attached Files

  2. #2
    WS Lounge VIP
    Join Date
    Mar 2002
    Newcazzle, UK
    Thanked 651 Times in 619 Posts
    Hi Howard

    The attached file should give you what you want.

    I changed a couple of things in the VBA code.

    Tested OK on my system.

    Attached Files Attached Files

  3. The Following User Says Thank You to zeddy For This Useful Post:

    HowardC (2012-03-16)

  4. #3
    Bronze Lounger
    Join Date
    Feb 2008
    Thanked 12 Times in 12 Posts
    Hi Zeddy

    Thanks for the help. Code works perfectly



Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts