VBA: Compare two list and if found add data into cell

Failed84

New Member
Joined
Apr 26, 2021
Messages
3
Office Version
  1. 365
Platform
  1. Windows
Hi Everyone,

I've been working on a VBA script but I'm struggling with the last section of the code. Let me start by being honest and saying that I'm not really good in VBA coding myself... I can manage and know what to in several situations and depend on open source code as well. For the last section of my script I have the following steps that I'd like it to do;

I have 2 list in 2 different Excel workbooks. One file is containing a list of e-mail addresses these e-mail addresses have to be used as a search in another Workbook and when found I have to add data in column M.

I did find a piece of code online that compares 2 results against each other but I've been having difficulty reading the code and editing it to my needs. The code does compare 2 lists.

VBA Code:
Sub FindDifferences()    
    Dim i As Long, ii As Long, sq1 As Variant, sq2 As Variant, m As Long


    sq1 = Sheet1.Cells(1).CurrentRegion.Columns(1)
    sq2 = Sheet2.Cells(1).CurrentRegion.Columns(1)


    Sheet3.Columns(1).ClearContents


    For i = 1 To UBound(sq1)
        ii = 0
        On Error Resume Next
        ii = Application.Match(sq1(i, 1), sq2, 0)
        On Error GoTo 0
        If ii = 0 Then
            m = m + 1
            Sheet3.Cells(m, 1).Value = sq1(i, 1)
        End If
    Next


    For i = 1 To UBound(sq2)
        ii = 0
        On Error Resume Next
        ii = Application.Match(sq2(i, 1), sq1, 0)
        On Error GoTo 0
        If ii = 0 Then
            m = m + 1
            Sheet3.Cells(m, 1).Value = sq2(i, 1)
        End If
    Next


End Sub

If there is another way to approach what I need, that is fine by me. This code did seem to do for the most part what I'd like it to do.
 

Excel Facts

Convert text numbers to real numbers
Select a column containing text numbers. Press Alt+D E F to quickly convert text to numbers. Faster than "Convert to Number"
The code above is comparing two list on different sheets within a same workbook. You want to compare list between 2 workbooks.

Copy the code below in normal module is workbook with email list you want to check. Run it and you will be asked for 2nd workbook you want to compare.
Modify the line below in code to your need:
ws2.Range("M" & cell.row) = <your data here>
VBA Code:
Sub CompareEMail()

Dim Fname As Variant, cell As Variant
Dim ws1 As Worksheet, ws2 As Worksheet
Dim wbA As Workbook, wbB As Workbook
Dim rngA As Range, rngB As Range
Dim rngFound As Range

Application.ScreenUpdating = False

' Define this Workbook as wbA
Set wbA = ActiveWorkbook
' Define working sheet in wbA. Change sheet name accordingly
Set ws1 = wbA.Sheets("Sheet1")
' Define data list range in wbA ws1 (assuming data start from A2 dowm where A1 is Header)
Set rngA = ws1.Range("A2", ws1.Cells(Rows.Count, "A").End(xlUp))

' Search destination Workbook
Fname = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls; *.xlsx; *.xlsm; *.xlsb), *.xls; *.xlsx; *.xlsm; *.xlsb", Title:="Select a File")
If Fname = False Then Exit Sub                         'CANCEL is clicked

' Define opened Workbook as wbB while opening it.
Set wbB = Workbooks.Open(Filename:=Fname, UpdateLinks:=False, ReadOnly:=True, IgnoreReadOnlyRecommended:=True)
' Define working sheet in wbB. Change sheet name accordingly
Set ws2 = wbB.Sheets("Sheet1")
' Define data list range in wbB ws2 (assuming data start from A2 dowm where A1 is Header)
Set rngB = ws2.Range("A2", ws2.Cells(Rows.Count, "A").End(xlUp))

' Compare each data in rngA with rngB in wbB to find match
For Each cell In rngA
    Set rngFound = rngB.Find(cell)
    If rngFound Then
        ' Data is found and you want to add something in column M
        ws2.Range("M" & cell.row) = <your data here>
    Else
        ' Nothing is found. Do what you want here
        
    End If
Next

End Sub
 
Upvote 0
Hi Zot,

Thanks for the script you made. Sadly it is not working.

I tried to change it to my needs but strangely breaks on the "If rngFound Then" part. This is what the code looks like now;

VBA Code:
Dim cell As Variant
Dim ws1 As Worksheet, ws2 As Worksheet, wbA As Workbook, wbB As Workbook
Dim rngA As Range, rngB As Range, rngFound As Range

currentDate = Format(Now(), "DD-MM-YYYY")

' Define this Workbook as wbA
Set wbA = Workbooks("Data - " & currentDate & ".xlsx")
' Define working sheet in wbA. Change sheet name accordingly
Set ws1 = wbA.Sheets("Data")
' Define data list range in wbA ws1
Set rngA = ws1.Range("A1", ws1.Cells(Rows.Count, "A").End(xlUp))



' Define opened Workbook as wbB while opening it.
Set wbB = Workbooks("bulk-data.xlsx")
' Define working sheet in wbB. Change sheet name accordingly
Set ws2 = wbB.Sheets("Performance")
' Define data list range in wbB ws2 (assuming data start from F2 dowm where A1 is Header)
Set rngB = ws2.Range("F2", ws2.Cells(Rows.Count, "F").End(xlUp))

' Compare each data in rngA with rngB in wbB to find match
For Each cell In rngA
    Set rngFound = rngB.Find(cell)
    If rngFound Then
     ' Data is found and you want to add something in column M
        ws2.Range("M" & cell.Row) = "Medewerker met deze gebruikersnaam bestaat al. Rollen dienen handmatig te worden toegevoegd in "
    Else
        
        MsgBox "Error;" & vbNewLine & "" & vbNewLine & "Medewerker niet gevonden.", vbInformation, "Not Found"
        
    End If
Next

Let me clear one thing up;

I have an Excel Workbook in which I post data that is being returned to me by e-mail. I press a button to execute a script and finally the file is being saved with the name Data - "Today's date".xlsx This file will contain after I've executed my code a list of E-mail addresses in column A.

The second file that is already open (because of my executed code) is the bulk-data.xlsx it has about 15.000 lines and in the code that has already been executed it will only show the lines of the last 3 days. The e-mail addresses should be in the bulk-data file in column F. When that email address is found in column F, a line has to be added in column M.

Hopefully this will clear things up.
 
Upvote 0

Forum statistics

Threads
1,213,535
Messages
6,114,192
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top