Question

I have the following worksheet called Data:

In the same workbook I have another worksheet called Employee Database.

In Excel, how can I color the “Employee E-mail Address” and the corresponding “Company” and “Company URL” cells red from the Data worksheet if the “Employee E-mail Address” is not in the Employee Database?

In otherwords, I am trying to make the Employee Database worksheet look like this:

I’ve just given an example and in reality I have over 10,000 cells worth of data to do this to. I started doing this manually and realized it will take me forever.

I’d love to know if there is a macro that can do this in Excel?

Help would be so much appreciated! I have the example workbook of the screenshots above available for download here:
http://www.mediafire.com/?dttztp66dvjkzn8

Answer 1

Is this what you are trying? This will create a new sheet “Desired Result” with the output. Paste this in a module.

Option Explicit

Sub Sample()
    Dim wsData As Worksheet, wsDB As Worksheet, wsO As Worksheet
    Dim lRow As Long, i As Long
    Dim clrRng As Range

    Set wsData = Sheets("Data")
    Set wsDB = Sheets("Employee Database")
    Set wsO = Sheets.Add

    On Error Resume Next
    Application.DisplayAlerts = False
    Sheets("Desired Result").Delete
    Application.DisplayAlerts = True
    On Error GoTo 0

    With wsO
        .Name = "Desired Result"
        wsData.Cells.Copy .Cells

        lRow = .Range("B" & .Rows.Count).End(xlUp).Row

        For i = 2 To lRow
            If .Range("A" & i).Value = "" Then .Range("A" & i).Value = .Range("A" & i - 1).Value
        Next i

        For i = 1 To lRow
            If Application.WorksheetFunction.CountIf(wsDB.Columns(3), .Range("A" & i).Value) = 0 Then
                If clrRng Is Nothing Then
                    Set clrRng = .Rows(i)
                Else
                    Set clrRng = Union(clrRng, .Rows(i))
                End If
            End If
        Next i

        If Not clrRng Is Nothing Then clrRng.Interior.ColorIndex = 3

        For i = lRow To 2 Step -1
            If .Range("A" & i).Value = .Range("A" & i - 1).Value Then .Range("A" & i).ClearContents
        Next i
    End With
End Sub