PDA

View Full Version : [SOLVED] Update Cell Value Based on Match to Outside Workbook



breader11
04-08-2013, 11:04 AM
Hi, friends. I have a list of 10K emails in my active workbook, where many duplicates exist. In another workbook I have a list of bad email addresses. I'm looking for a macro that would help me update the Status column in my active workbook with the word "bad" if there is a match. Here's the best, most susinct way I can describe what I'm looking for:

"If the email address listed in Column A of my active Workbook1 matches the email address listed in Column A of Workbook2, then place "bad" in Column B of Workbook 1."

Can anyone help with this? Thanks!

mdmackillop
04-08-2013, 11:40 AM
Do you mean Workbook or Worksheet?

breader11
04-08-2013, 01:10 PM
I have two workbooks, each containing a worksheet (Sheet1). One worksheet has the 10K current emails, the other about 500 bad emails. Does that answer your question adequately?

mdmackillop
04-08-2013, 01:41 PM
Sub BadAddress()
Dim ws1 As Worksheet
Dim cel As Range
Dim Bad As Range
Set ws1 = ActiveWorkbook.Sheets(1)
Set Bad = Workbooks("Book2.xlsx").Sheets(1).Columns(1).SpecialCells(xlCellTypeConstants)
For Each cel In Bad
Set c = ws1.Columns(1).Cells.Find(cel, LookAt:=xlWhole)
If Not c Is Nothing Then c.Offset(, 1) = "Bad"
Next
End Sub

breader11
04-09-2013, 06:33 AM
Thank you mdmackillop for your quick reply. I've renamed my Workbook 2 "Book2.xlsx" just to make sure your code worked correctly for my purpose.

I'm getting an error (red text below). FYI, both the active workbook and Book2.xlsx are located in the same folder on my desktop. The path for both documents is C:\Users\breader\Desktop\test1\[file name] (I don't know if that matters).

Sorry, I'm not familiar with VBA, so I'm groping in the dark somewhat.

------------------------------------


Sub BadAddress()
Dim ws1 As Worksheet
Dim cel As Range
Dim Bad As Range
Set ws1 = ActiveWorkbook.Sheets(1)
Set Bad = Workbooks("Book2.xlsx").Sheets(1).Columns(1).SpecialCells(xlCellTypeConstants)
For Each cel In Bad
Set c = ws1.Columns(1).Cells.Find(cel, LookAt:=xlWhole)
If Not c Is Nothing Then c.Offset(, 1) = "Bad"
Next
End Sub

mdmackillop
04-09-2013, 07:15 AM
I've assumed both workbooks were open when the code was run. Do you require WB2 to be opened by the code?

breader11
04-09-2013, 08:13 AM
If it's possible that I could be prompted to navigate to the file, that would be great. But now that I know both files should be opened, it works like magic! Thanks for all your help!

breader11
04-10-2013, 07:51 AM
Hi again, mdmackillop. The code works great. I've modified it slightly to create three different macros to identify blocked, bounced, and invalid emails. The process made me think that possibly this could all be done through one pass, rather than three.

Here is what I'm wondering:

If my Workbook 2 contained two columns (the first containing the long list of emails, the second containing the status of each email (e.g. blocked, bounced, invalid)) then my macro would work the same way, but rather than placing the hard-coded "bad," it would place the status associated with that email match (e.g. the cell in the second column)

Is that possible?

mdmackillop
04-10-2013, 10:10 AM
Untested.
Add the status (Blocked, Bounced, Invalid) in row 1 above the bad addresses. The code should check each address against you good list and insert the Status in the adjoining cell.


Option Explicit

Sub BadAddress()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim c As Range
Dim cel As Range
Dim Bad As Range
Dim Fnd As Range
Dim r As Range
Set ws1 = ActiveWorkbook.Sheets(1)
Set ws2 = Workbooks("Book2.xlsx").Sheets(1)
Set Bad = ws2.Rows(1).SpecialCells(xlCellTypeConstants)
For Each cel In Bad
Set c = cel.EntireColumn.SpecialCells(xlCellTypeConstants)
For Each r In c
Set Fnd = ws1.Columns(1).Cells.Find(r, LookAt:=xlWhole)
If Not Fnd Is Nothing Then Fnd.Offset(, 1) = c(1)
Next
Next
End Sub

breader11
04-10-2013, 11:51 AM
Thanks again, but I got some odd results this time: about 400 records were returned "Blocked, Bounced, Invalid." I thought it was strange when I saw your instructions to list the words "Blocked, Bounced, Invalid" in the first row of all the bad emails.

Just to reiterate, in WB2, there are ~ 1,000 bad emails in column A. In column B I have the word "Blocked" or "Bounced" or "Invalid" next to every email listed. In WB1, there are ~10,000 emails (both good and bad) in column A. Column B of this WB is empty.

With WB1 active, I'd like the macro to look at column A of WB2 (opened, but minimized) and where it finds a match, to return the cell from WB2, column B into column B of WB1.

Does that make any more sense?

mdmackillop
04-10-2013, 12:29 PM
Can you post a sample layout; just use 2 sheets in 1 book with Test1, Test2 etc, instead of email addresses

breader11
04-10-2013, 01:41 PM
Hi, mdmackillop.

Attached is the file you requested. Let me know if you have any questions. Thank you for all your efforts and generosity.

Sincerely,

Bill

mdmackillop
04-10-2013, 02:13 PM
I've deleted the attachments to prevent the email addresses being harvested
Give this a try; it should work with WB2 open or closed (assuming WB2.xlsx is the correct name!)


Option Explicit

Sub Test()
Dim wb2 As Workbook
Dim Pth As String
Dim chk As Boolean
Dim R1 As Range, R2 As Range
Dim Cel As Range, C As Range
Application.ScreenUpdating = False
'Data to check
Set R1 = ActiveWorkbook.Sheets(1).Columns(1)
On Error Resume Next
Set wb2 = Workbooks("WB2.xlsx")
'Open WB2 if required
Pth = ActiveWorkbook.Path
If wb2 Is Nothing Then
chk = True
Set wb2 = Workbooks.Open(Pth & "\wb2.xlsx")
End If
'Get Bad addresses
Set R2 = wb2.Sheets(1).Columns(1).SpecialCells(xlCellTypeConstants)
'Seach good list for bad addresses
For Each Cel In R2
Set C = R1.Find(Cel, lookat:=xlWhole)
If Not C Is Nothing Then C.Offset(, 1) = Cel.Offset(, 1)
Next
'Close WB2 if not previously open
If chk Then wb2.Close False
Application.ScreenUpdating = True
End Sub

breader11
04-12-2013, 07:57 AM
Thanks! I'll check it out and test tonight!

breader11
04-12-2013, 01:34 PM
Works perfectly, mdmackillop! Thanks for all your patience and hard work.

Sincerely,
Bill

breader11
04-13-2013, 11:14 AM
Hi, mdmackillop. Sorry to write back so soon, but I spotted a small problem with the vba code that I thought you might be able to help with. I noticed that once an email match is found and the proper status is placed in the adjacent cell (as your code perfectly executes), the code no longer seeks to match on another record with the same email address. This means that if there are 10 duplicate emails in the list, your code will match the first one, but ignore the next 9, leaving them blank.

Let me know if you think this can be rectified.

mdmackillop
04-13-2013, 02:17 PM
This can be done, or duplicates can be deleted. Which is better?

breader11
04-13-2013, 04:47 PM
Thank you for your quick reply. Duplicate emails are common on the spreadsheets that I will be using, so it is important that they remain. Thanks again!

mdmackillop
04-13-2013, 06:04 PM
Option Explicit

Sub Test()
Dim wb2 As Workbook
Dim Pth As String
Dim chk As Boolean
Dim R1 As Range, R2 As Range
Dim Cel As Range, C As Range
Dim FirstAddress As String
Application.ScreenUpdating = False
'Data to check
Set R1 = ActiveWorkbook.Sheets(1).Columns(1)
On Error Resume Next
Set wb2 = Workbooks("WB2.xlsx")
'Open WB2 if required
Pth = ActiveWorkbook.Path
If wb2 Is Nothing Then
chk = True
Set wb2 = Workbooks.Open(Pth & "\wb2.xlsx")
End If
'Get Bad addresses
Set R2 = wb2.Sheets(1).Columns(1).SpecialCells(xlCellTypeConstants)
'Seach good list for bad addresses
With R1
For Each Cel In R2
Set C = .Find(Cel, LookAt:=xlWhole)
If Not C Is Nothing Then
FirstAddress = C.Address
Do
If Not C Is Nothing Then C.Offset(, 1) = Cel.Offset(, 1)
Set C = .FindNextŠ
Loop While Not C Is Nothing And C.Address <> FirstAddress
End If
Next Cel
End With
'Close WB2 if not previously open
If chk Then wb2.Close False
Application.ScreenUpdating = True
End Sub

breader11
04-13-2013, 06:49 PM
You are brilliant. Really.
Thank you very much.

Bill