Solved

EXcel VBA: Retrieving Contact Details by name, where 2 entries may have same name

Posted on 2012-04-02
10
524 Views
Last Modified: 2012-04-02
Hi guys, I have a transmittal system, that automatically emails transmittal information out to appropriate users. It gets the users names from a  list specific to the active project, then looks that user up in a contacts matrix that lists all contacts across all projects.

My issue is that there may come a time when 2 contacts in that list have the same name. The contacts list contains their names, email, phone, employer and a unique id number for each entry.

I need my code to go away look at this contacts matrix and find a user by name to retrieve his email, this I have working, but, I want it to FIRST, check if there are multiple entries for this name and if so prompt the user to select which is the contact they want via a drop down listing the two identical user names plus their company name.


The code I'm using to get the Transmittal sheet go and find the contact details is as follows:
Sheets("Transmittal").Select

' Internal Distribution

Workbooks.Open Filename:="\\xxxxxxxx\Projects\_Project Contacts Matrix\Projects Contacts Matrix.xlsm" 'Contacts list with full details for everyone

If Not myDict Is Nothing Then
    myDict.RemoveAll
Else
    Set myDict = CreateObject("Scripting.Dictionary")
End If

For Each r In Workbooks("Transmittal Log.xlsm").Sheets("Transmittal").Range("A9:A25") 'Lists the Full names of the contacts I need to email to'
    If r.Value <> "" Then
        If Not myDict.exists(r.Value) Then
        myDict.Add r.Value, i
        i = i + 1
        Workbooks("Projects Contacts Matrix.xlsm").Activate 'the workbook containing the full contact details'
            Range("G:G").Select      'Column where full name is found'
            Set RangeToSearch = Selection
            Set FoundCell = RangeToSearch.Find(r.Value)
                If Not FoundCell Is Nothing Then
                iDistRow = RangeToSearch.Find(r.Value).Row
                Else
                MsgBox "No Contact Details found for " & r.Value & ". Mail Not Sent"
                Exit Sub
                End If
        Distrib2 = Distrib2 & ";" & Range("D" & iDistRow).Value 'Add the email address of that contact'
        Workbooks("Transmittal Log.xlsm").Activate
        End If
    End If
Next r

myDict.RemoveAll
Set myDict = Nothing

Open in new window



As you can see, with the search function, I'll by default just get the first entry with that name. I need if there are 2 entries with the same name have them both pop up (showing name and Company name [ column C] with a select option for the user to decide which on he wants.

Any idea's? Have I given enough information for anyone to figure it out?
0
Comment
Question by:Conor_Newman
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 4
  • 4
  • 2
10 Comments
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 37795732
You are using the fullname as your index in the dictionary, you could modify for example:


        If Not myDict.exists(r.Value) Then

as is for the not found case and in the found case modify the value by adding a "|" character as an example followed by the next set of data ... and then split the values using the "|" to establish how many entries are associated with a name.

Chris
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 37795760
Ignore my alternative .. as I view your code a bit further I see the issue is that the data is located in another workbook using the same key data so it isn't so straightforward.

Chris
0
 
LVL 2

Author Comment

by:Conor_Newman
ID: 37795813
Yeah, it's a bit of a pain.

Think maybe I need to search through the range("G:G") in the contacts list workbook for my r.value, and add each entry matching that name to an array also taking their company name, using a count integer to count how many entries there is, if the count integer is greater than 1, then pass the array into a combobox in a pop up, and let the user select which one, if the count integer = 1, then just use that persons email.

Problem is I'm not sure how to go about this...
0
Online Training Solution

Drastically shorten your training time with WalkMe's advanced online training solution that Guides your trainees to action. Forget about retraining and skyrocket knowledge retention rates.

 
LVL 17

Expert Comment

by:andrewssd3
ID: 37795915
Two thoughts:
if your contacts data is sorted you could just look ahead after a successful find to see if the name in the next row is the same - then you could pop up your question
If the data is not sorted, you could add a new column to the contacts data using countif to count the number of occurrences of that name in the whole list.  Then you could query this to see if there were more than one entry -
for example in col H you could have something like
=COUNTIF($G$3:$G$350,A3)

Open in new window

- this would be 1 in most cases, higher where there were duplicates
0
 
LVL 2

Author Comment

by:Conor_Newman
ID: 37795987
Hi Andrew,

Identifying if there is a duplicate isn't the issue, having a pop up in the other workbook, allowing the user to select which of the users to use in the case there is a duplicate is the issue.
0
 
LVL 17

Expert Comment

by:andrewssd3
ID: 37796013
OK - so you want the VBA code to create a userform displaying the duplicates and returning the selected one?  That's doable, but I'm at work at the moment and is's more than a 2 minute job.  I'll do something this evening if someone else hasn't jumped in for you by then.
0
 
LVL 2

Author Comment

by:Conor_Newman
ID: 37796027
Yes, I have no problem creating userforms, but, getting the code from existing macro to create one and pass the data from the duplicates into a combobox on the UserForm, then take back the data the users selects as a variable that I can use to move on with.

Not sure at all how to do that lol.
0
 
LVL 59

Accepted Solution

by:
Chris Bottomley earned 500 total points
ID: 37796032
A first attempt ... not especially neat is as below, basically creates a range of matching cells in teh address workbook and prompts for a value before returning it in the pre-existing Distrib2 variable.

Sheets("Transmittal").Select

' Internal Distribution

Workbooks.Open Filename:="\\xxxxxxxx\Projects\_Project Contacts Matrix\Projects Contacts Matrix.xlsm" 'Contacts list with full details for everyone

If Not mydict Is Nothing Then
    mydict.RemoveAll
Else
    Set mydict = CreateObject("Scripting.Dictionary")
End If

For Each r In Workbooks("Transmittal Log.xlsm").Sheets("Transmittal").Range("A9:A25") 'Lists the Full names of the contacts I need to email to'
    idistrow = ""
    If r.Value <> "" Then
        If Not mydict.exists(r.Value) Then
        mydict.Add r.Value, i
        i = i + 1
        Workbooks("Projects Contacts Matrix.xlsm").Activate 'the workbook containing the full contact details'
        With Sheets(1)
            .Select
            .Range("G:G").Select      'Column where full name is found'
            Set masterrange = Selection
            Set rangetosearch = masterrange
            Set foundcell = rangetosearch.Find(r.Value)
            Do While Not foundcell Is Nothing
                If idistrow <> "" Then idistrow = idistrow & ","
                idistrow = idistrow & foundcell.Row
                Set rangetosearch = masterrange.Resize(masterrange.Rows.Count - foundcell.Row, 1).Offset(foundcell.Row, 0)
                Set foundcell = rangetosearch.FindNext
            Loop
            If idistrow = "" Then
'                MsgBox "No Contact Details found for " & r.Value & ". Mail Not Sent"
            ElseIf InStr(idistrow, ",") = 0 Then
'                MsgBox "One found"
            Else
                strOptions = ""
'                MsgBox "Multiple finds"
                arroptions = Split(idistrow, ",")
                For itm = 0 To UBound(arroptions)
                    strOptions = strOptions & itm + 1 & " :> " & .Range("D" & arroptions(itm)).Value & vbCrLf
                Next
                intval = -1
                Do While intval < LBound(arroptions) Or intval > UBound(arroptions)
                    intval = InputBox(strOptions, "Select relevant data row", "")
                    If IsNumeric(intval) Then
                        intval = CInt(intval) - 1
                    Else
                        intval = 0
                    End If
                Loop
            End If
                
            If idistrow <> "" Then
                Distrib2 = Distrib2 & ";" & Range("D" & arroptions(intval)).Value 'Add the email address of that contact'
            End If
        End With
        Sheets(1).Select
'        Workbooks("Transmittal Log.xlsm").Activate
        End If
    End If
Next r

mydict.RemoveAll
Set mydict = Nothing
End Sub

Open in new window

0
 
LVL 2

Author Closing Comment

by:Conor_Newman
ID: 37796449
Actually works perfectly Chris. Thank you! A few minor edits to include the Contacts Company name etc and it was exactly what I needed. Nice idea with the numbered options instead of the hassle of creating a userform. Very practical, and still uses the search rather than a scroll through every value in a range, so it's still fast and efficient to run.

All in all, vert very nice. :)
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 37797463
:o)

Glad it helps, and thank you very much for the kind comments.

Chris
0

Featured Post

Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Some code to ensure data integrity when using macros within Excel. Also included code that helps secure your data within an Excel workbook.
Ever visit a website where you spotted a really cool looking Font, yet couldn't figure out which font family it belonged to, or how to get a copy of it for your own use? This article explains the process of doing exactly that, as well as showing how…
Many functions in Excel can make decisions. The most simple of these is the IF function: it returns a value depending on whether a condition you describe is true or false. Once you get the hang of using the IF function, you will find it easier to us…
Do you want to know how to make a graph with Microsoft Access? First, create a query with the data for the chart. Then make a blank form and add a chart control. This video also shows how to change what data is displayed on the graph as well as form…

734 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question