with excel vba compare 2 worksheet columns but only to first dot

Question

i have a master sheet and a daily sheet, i would like to compare the email addresses in the daily sheet against the addresses in master sheet (both column A) and msgbox a list of any that are not on the master sheet, the problem is i only need to compare up to the 1st dot, but need the full email address in the message box

for example

Master file                     Daily file
john.co.uk                      john.com 
gim                             elephant.com
jeff.com.org                    jeff.co.com
scream.com                      scream
fish.cpl                        banana

    result in msg box

    elephant.com
    banana

Dim C_ell As Range, Sh_D As Worksheet, Sh_M As Worksheet
Dim F_ound As Boolean, C_ell2 As Range
Set Sh_D = Sheets("") 'Set the active worksheet first
'Open Master workbook

On Error Resume Next
If IsError(Workbooks("")) Then
    Workbooks.Open Filename:=ActiveWorkbook.Path & "\" & ""
Else
    Workbooks("").Activate
End If
On Error GoTo 0
'Set the Master sheet for reference
Set Sh_M = Sheets("")
Sh_D.Activate
F_ound = False
For Each C_ell In Range("A1", Cells(Rows.Count, 1).End(xlUp))
    Sh_M.Activate
    For Each C_ell2 In Range("A1", Cells(Rows.Count, 1).End(xlUp))
        If InStr(1, C_ell2, Left(C_ell, InStr(1, C_ell, ".", vbTextCompare)), vbTextCompare) <> 0 Then
            F_ound = True
        End If
    Next
    If Not F_ound Then
        Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) = C_ell
    End If
    F_ound = False
Next

hope it makes sense

sorry this is what i have tried so far F_ound = False For Each C_ell In Range("A1", Cells(Rows.count, 1).End(xlUp)) Sh_M.Activate For Each C_ell2 In Range("A1", Cells(Rows.count, 1).End(xlUp)) If InStr(1, C_ell2, Left(C_ell, InStr(1, C_ell, ".", vbTextCompare)), vbTextCompare) <> 0 Then F_ound = True End If Next If Not F_ound Then Cells(Rows.count, 1).End(xlUp).Offset(1, 0) = C_ell End If F_ound = False Next — user3360439, Mar 31 '14 at 05:43

score 0 · Answer 1 · edited May 23 '17 at 12:14

Here I've got your two lists of email addresses on two different worksheets, "master" and "daily".

This code stores the two ranges of emails as arrays, and then compares the elements of those arrays. You can make the code more concise but I've kept it this way to make it easier to read and see what's going on.

Sub test2()

    Dim arrMaster() As Variant   ' array of emails on 'master' sheet
    Dim arrDaily() As Variant    ' array of emails on 'daily' sheet

    Dim strComp1 As String       ' string to compare
    Dim strComp2 As String       ' string to compare
    Dim txt As String            ' text to output

    Dim counter As Integer
    Dim booFound As Boolean

    Dim wksMaster As Worksheet   ' Master worksheet
    Dim wksDaily As Worksheet    ' Daily worksheet

    Dim i As Integer
    Dim j As Integer

    Set wksMaster = Worksheets("master")
    Set wksDaily = Worksheets("daily")

    counter = 0
    arrMaster = wksMaster.Range("A1", wksMaster.Range("A" & Rows.Count).End(xlUp))
    arrDaily = wksDaily.Range("A1", wksDaily.Range("A" & Rows.Count).End(xlUp))


    For i = 1 To UBound(arrDaily())

        If InStr(1, arrDaily(i, 1), ".", vbTextCompare) > 0 Then
            strComp1 = Left(arrDaily(i, 1), (InStr(1, arrDaily(i, 1), ".", vbTextCompare)) - 1)
        Else
            strComp1 = arrDaily(i, 1)
        End If

        For j = 1 To UBound(arrMaster())

            If InStr(1, arrMaster(j, 1), ".", vbTextCompare) > 0 Then
                strComp2 = Left(arrMaster(j, 1), (InStr(1, arrMaster(j, 1), ".", vbTextCompare)) - 1)
            Else
                strComp2 = arrMaster(j, 1)
            End If

            booFound = False
            'test if the strings match
            If strComp1 = strComp2 Then
                booFound = True
                Exit For
            End If
        Next j

        If booFound = False Then
            'no match was found - create text output
            If counter = 0 Then
                txt = arrDaily(i, 1)
                counter = counter + 1
            Else
                txt = txt & vbCr & arrDaily(i, 1)
                counter = counter + 1
            End If

        End If

    Next i

    'output text
    MsgBox txt

    Set wksMaster = Nothing
    Set wksDaily = Nothing

End Sub

You should also avoid using Activate in your code as it can cause problems. See here for a good explanation.

with excel vba compare 2 worksheet columns but only to first dot

1 Answers1