Match up emails with names

COwebmaster
COwebmaster used Ask the Experts™
on
In column A are names and in column B I have emails. I then removed all of the emails that are present in my unsubscribe list. Now I have about 1K less emails. I want to now match the name with the final list of emails. Anyway to do that using an Excel formula or Macro?
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
I think you are going to have to either supply an example (using bogus names and email addresses) or explain better.

Names in A and matching email addresses in B.
You delete the email addresses you don't want to keep.
Did you select the whole rows and use the "delete Row" option?
If so, the email addresses should still be adjacent to the matching names.

Author

Commented:
Okay attached is a sample file. In column A are the individual names and in column B is their email. In column C I put in my list of emails of all my unsubscribes. Column D outputs my new list of emails. I need the names in column A associated with the emails in column D.

The macros you see in the file makes the emails in column B and in column C all lowercase which are the first steps I do. I then click on the other macro to output the new list. It would be nice that the same macro button would display the name alongside each email in column D perhaps in column E.

Thanks for your help with this.
Remove-all-unsubscribes.xlsm
Excel & VBA Expert
Most Valuable Expert 2018
Awarded 2015
Commented:
I have tweaked the macro called GetEmailList so that when you click the button called "Create Email List", it will populate the column D with Emails and column E with their corresponding names.

Sub GetEmailList()
Dim lr As Long
Dim x, y
Dim dict1 As Object, dict2 As Object
lr = Cells(Rows.Count, 1).End(xlUp).Row
x = Range("A2:B" & lr).Value
lr = Cells(Rows.Count, 2).End(xlUp).Row
y = Range("C2:C" & lr).Value

Set dict1 = CreateObject("Scripting.Dictionary")
Set dict2 = CreateObject("Scripting.Dictionary")

lr = Cells(Rows.Count, 3).End(xlUp).Row
If lr > 1 Then Range("D2:E" & lr).Clear
With dict1
   For i = 1 To UBound(y, 1)
      .Item(y(i, 1)) = ""
   Next i
End With

With dict1
   For i = 1 To UBound(x, 1)
      If Not .exists(x(i, 2)) Then
         dict2.Item(x(i, 2)) = x(i, 1)
      End If
   Next i
End With
Range("D2").Resize(dict2.Count).Value = Application.Transpose(dict2.keys)
Range("E2").Resize(dict2.Count).Value = Application.Transpose(dict2.items)
Range("E1").Value = "Name"
End Sub

Open in new window

Remove-all-unsubscribes.xlsm

Author

Commented:
Thanks Subodh, it worked great!
Subodh Tiwari (Neeraj)Excel & VBA Expert
Most Valuable Expert 2018
Awarded 2015

Commented:
You're welcome! Glad it worked as desired.

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial