Home » excel » excel – Match username (array) to email (array)

excel – Match username (array) to email (array)

Posted by: admin May 14, 2020 Leave a comment

Questions:

Using Excel 2013. My first post after years of finding and adapting.

I’m trying to match the current App user, ie “John Smith”, to his email address “[email protected]”.

Using two strings: 1 for users (1 to 3), the other eaddress(1 To 3).
I want to get the current user’s email address for use in separate Sub that CCs the current user on an email.

I tried a For Each i In user, and set eName to eaddress(i).
This returned only the last listed user/email.

Private Sub (useremail)
Dim user (1 To 3), eaddress (1 To 3), fullName, eName As String

fullName = Application.UserName
user(1) = "John Smith"
user(2) = "Debbie Adams"
user(3) = "Karen Jones"

eaddress(1) = "[email protected]"
eaddress(2) = "[email protected]"
eaddress(3) = "[email protected]"

For i = 1 To 3
    'For Each i In user
        fullName = user(i)
        eName = eaddress(i)
    'Exit For
    debug.print "User is " & fullname & "email to " & eName
Next i


Looking to get the eaddress/eName of the current user (for use in separate Sub to email file).

How to&Answers:

You can use a Dictionary to make this easier

Private Sub UsereMail()
    Dim dictInfo, fullName

    fullName = Application.UserName

    Set dictInfo = CreateObject("Scripting.Dictionary")
    dictInfo.Add "John Smith", "[email protected]"
    dictInfo.Add "Debbie Adams", "[email protected]"
    dictInfo.Add "Karen Jones", "[email protected]"

    If dictInfo.Exists(fullName) Then
        Debug.Print "User is " & fullName & " email to " & dictInfo(fullName)
    End If
End Sub

Answer:

Using your original array-based approach:

Sub tester()
    Debug.Print "John Smith", UserEmail("John Smith") '>> [email protected]
    Debug.Print "John Brown", UserEmail("John Brown") '>> [blank]
End Sub


Private Function UserEmail(userName As String) As String

    Dim user(1 To 3), eaddress(1 To 3), m

    user(1) = "John Smith"
    user(2) = "Debbie Adams"
    user(3) = "Karen Jones"

    eaddress(1) = "[email protected]"
    eaddress(2) = "[email protected]"
    eaddress(3) = "[email protected]"

    m = Application.Match(userName, user, 0)
    If Not IsError(m) Then UserEmail = eaddress(m)

End Function

Answer:

Another dictionary based approach where the list of users does not have to be in the same order as the email addresses.

Option Explicit

Sub Test()
Dim user(1 To 3)            As String
Dim eaddress(1 To 3)        As String
Dim user_dic                As Scripting.Dictionary

user(1) = "John Smith"
user(2) = "Debbie Adams"
user(3) = "Karen Jones"

eaddress(1) = "[email protected]"
eaddress(2) = "[email protected]"
eaddress(3) = "[email protected]"

Set user_dic = MatchUsersToEmail(eaddress, user)

Debug.Print eaddress(1), user_dic.Item(eaddress(1))
Debug.Print eaddress(2), user_dic.Item(eaddress(2))
Debug.Print eaddress(3), user_dic.Item(eaddress(3))

End Sub

Public Function MatchUsersToEmail(ByRef email_array() As String, ByRef user_array() As String) As Scripting.Dictionary
' Returns a scripting dictionary where the email address returns the user name
Dim my_users                As Scripting.Dictionary
Dim my_user                 As Variant
Dim my_email                As Variant
Dim my_name()               As String
Dim my_key                  As String
    Set my_users = New Scripting.Dictionary

    For Each my_email In email_array
        ' Add the email address as the key
        my_users.Add Key:=CStr(my_email), Item:=vbNullString

    Next

    For Each my_user In user_array
        my_name = Split(LCase$(my_user))
        my_key = Left$(my_name(0), 1) & my_name(1) & "@work.com"
        my_users.Item(my_key) = my_user

    Next

    Set MatchUsersToEmail = my_users

End Function