MS Excel VBA Function Not Updating Sheet when duplicates in Source Sheet

[OilEconomist]

Thanks in advance for your assistance. I took the awesome work by mumps in the following code and modified it to my needs.

Find missing values between two columns with VBA

Hello, I need your help, i have 2 columns that are not on the same sheet, the first one is a table and the second one is updated at each opening of the excel file. I would like to compare both columns, and if a data is in the column 2 and not in the column 1, add it at the end of the 1st...

www.mrexcel.com

I am having a couple of issues and would like to ask for assistance.

1. How do I modify the function so if the sheet (referred to as Sheets(ShtNmUpdt) in the function and "Sheet1" of the Sub) has duplicates values, it still includes everything after the duplicate value. For example, once it sees Celtics twice, it stops adding to the list and only up to the first "Celtics", it gets updated. I believe the section of the code that needs to be modified is within the function:

    With Sheets(ShtNmOrgl)
        For Each Rng In .Range(AdrsOrgl, .Cells(.Rows.Count, ColNoOrgl).End(xlUp))
            If Not RngList.Exists(Rng.Value) Then
                 RngList.Add Rng.Value, Nothing     '
            End If
        Next
    End With

2. If a value was not in Sheets(ShtNmOrgl) ("Sheet2" of the sub), I would like to shade that value in Sheets(ShtNmUpdt) ("Sheet1" of the sub). It could be this line of code:

aDicMisgVal.Add Rng.Value, Nothing

in this section of the function:

   With Sheets(ShtNmUpdt)
        For Each Rng In .Range(AdrsUpdt, .Cells(.Rows.Count, ColNoUpdt).End(xlUp))
            If aDictionary.Exists(Rng.Value) Then
                'do nothing so it gets excluded from the list
            ElseIf Not RngList.Exists(Rng.Value) Then
                aDicMisgVal.Add Rng.Value, Nothing
                Sheets(ShtNmOrgl).Cells(Sheets(ShtNmOrgl).Rows.Count, ColNoOrgl).End(xlUp).Offset(1, 0) = Rng
            End If
        Next
    End With

and or the following code:

    With Sheets(ShtNmUpdt)
        For Each Rng In .Range(AdrsOrgl, .Cells(.Rows.Count, ColNoOrgl).End(xlUp))
            If ColrMisgVal = "Yes" And aDicMisgVal(Rng.Val).Exists Then
                Rng.Interior.ColorIndex = 38
            End If
        Next
    End With

Here is the "Sheet2" (name within the sub) which is Sheets(ShtNmOrgl) within the function before any updates:

Book1
	A	B	C
1
2		TEAM
3		Lakers
4		Warriors
5
6
7
Sheet2

Here is the "Sheet1" (name within the sub) which is Sheets(ShtNmOrgl). The sheet with the updates. Basically, all values in "Sheet2" that are not in "Sheet1", will be added to "Sheet1" and then color them/shade the cells in "Sheet2"

Book1
	A	B	C	D
1
2			TEAM
3			Warriors
4			Rockets
5			Mavericks
6			Celtics
7			Celtics
8			Pistons
9
Sheet1

"Sheet2" actual results

Book1
	A	B	C
1
2		TEAM
3		Lakers
4		Warriors
5		Rockets
6		Mavericks
7		Celtics
8
Sheet2

"Sheet2" desired results

Book1
	A	B	C
1
2		TEAM
3		Lakers
4		Warriors
5		Rockets
6		Mavericks
7		Celtics
8		Pistons
9
Sheet2

"Sheet1" shading to show what was updated in "Sheet2"

Book1
	A	B	C	D
1
2			TEAM
3			Warriors
4			Rockets
5			Mavericks
6			Celtics
7			Celtics
8			Pistons
9
10
Sheet1

The sub:

Sub CompareTest()

    Dim aDictionary As Object

    Set aDictionary = CreateObject("Scripting.Dictionary") 'nothing is stored in the dictionary to be excluded in this version
    CmprListsNAddF "Sheet2", "Sheet1", "TEAM", aDictionary, "Yes"

End Sub

The function:

Function CmprListsNAddF(ShtNmOrgl As String, ShtNmUpdt As String, ColHdgNm As String, _
                         aDictionary As Object, ColrMisgVal As String) As Variant

'Notes
    'ShtNmOrgl as String - The sheet with the original data which will be updated
    'ShtNmUpdt as String - The sheet with the data with updates. It will be transferred to the ShtNmOrgl
    'ColHdgNm as String - The name of the column Heading with the data to be updated
    'aDictionary As Object - The values to be excluded from the list. _
        This needs to be declared in the Sub where, for example, "aDictionary" is setting, the following _
        needs to be done: _
        Dim aDictionary as Object _
        Set aDictionary = CreateObject("Scripting.Dictionary") _
        Then read the values if any into aDictionary. If there are none, it can be left blank. Two examples: _
            (1)aDictionary("MARK") = Empty _
            (2) For j = 2 To 6 _
                    aDictionary(.Cells(j, 1).Value) = Empty -> in this example, 1 is the column no. _
                Next j _
            basically in these examples what's in the parethesis is the value being stored in the _
            dictionary, which will be exlcuded to be added

 '_______________________________________________________________________________________________________________
 'Turn off alerts, screen updates, and automatic calculation
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    Application.Calculation = xlManual           
            
 '_______________________________________________________________________________________________________________
 'Dimensioning
  
    'Dim longs
     Dim LastRow As Long
     
     Dim RowNoOrgl As Long
     Dim ColNoOrgl As Long
     
     Dim RowNoUpdt As Long
     Dim ColNoUpdt As Long
     
     Dim RowNo As Long
     Dim ColNo As Long

    
    'Dim Strings
     Dim AdrsOrgl As String
     Dim ColLetOrgl As String
     Dim AdrsUpdt As String
     Dim ColLetUpdt As String
     
     Dim ErrMsg1 As String
     Dim ErrMsg2 As String
     
     
    'Dim Ranges
     Dim Rng As Range
     
     
    'Dim Objects
     Dim RngList As Object
     Dim aDicMisgVal As Object
     
    
    'Dim Variants
     Dim ColHdgNmOrgl As Variant
     Dim ColHdgNmUpdt As Variant
    
    
    'Dim Timer variables
     Dim TimerCount As Long
     Dim BenchMark As Double
 
 
 '______________________________________________________________________________________________________________
    
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    
    Set RngList = CreateObject("Scripting.Dictionary")
    
    Set aDicMisgVal = CreateObject("Scripting.Dictionary")



 '______________________________________________________________________________________________________________

    With Sheets(ShtNmOrgl)
        
        On Error GoTo 1000
        Set ColHdgNmOrgl = .Cells.Find(what:=ColHdgNm, LookIn:=xlFormulas, LookAt _
                :=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
                False, SearchFormat:=False)
        
        If ColHdgNmOrgl Is Nothing Then
            ErrMsg1 = "Yes"
            GoTo 1000
        Else
            AdrsOrgl = ColHdgNmOrgl.Address
            RowNoOrgl = ColHdgNmOrgl.Row
            ColNoOrgl = ColHdgNmOrgl.Column
        End If
        
    End With
        
 
 
 '______________________________________________________________________________________________________________

1000:
    With Sheets(ShtNmUpdt)
        
        On Error GoTo 2000
        Set ColHdgNmUpdt = .Cells.Find(what:=ColHdgNm, LookIn:=xlFormulas, LookAt _
                :=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
                False, SearchFormat:=False)
        
        If ColHdgNmOrgl Is Nothing Then
            ErrMsg2 = "Yes"
        Else
            AdrsUpdt = ColHdgNmUpdt.Address
            RowNoUpdt = ColHdgNmUpdt.Row
            ColNoUpdt = ColHdgNmUpdt.Column
        End If

    End With
        
        
 '______________________________________________________________________________________________________________
    
    With Sheets(ShtNmOrgl)
        For Each Rng In .Range(AdrsOrgl, .Cells(.Rows.Count, ColNoOrgl).End(xlUp))
            If Not RngList.Exists(Rng.Value) Then
                 RngList.Add Rng.Value, Nothing 
            End If
        Next
    End With
 
 
 
 '______________________________________________________________________________________________________________
 
    With Sheets(ShtNmUpdt)
        For Each Rng In .Range(AdrsUpdt, .Cells(.Rows.Count, ColNoUpdt).End(xlUp))
            If aDictionary.Exists(Rng.Value) Then
                'do nothing so it gets excluded from the list
            ElseIf Not RngList.Exists(Rng.Value) Then 'if it is not already in the sheet, add it.
                aDicMisgVal.Add Rng.Value, Nothing 'this stores all the values that were not in the list
                Sheets(ShtNmOrgl).Cells(Sheets(ShtNmOrgl).Rows.Count, ColNoOrgl).End(xlUp).Offset(1, 0) = Rng
            End If
        Next
    End With
    
    
    
 '________________________________________________________________________________________________________
 'Code - This goes through the sheet ShtNmOrgl (the sheet with the missing values in Sheets(ShtNmUpdt) _
         which were updated) and colors them if indicated.
    
    With Sheets(ShtNmUpdt)
        For Each Rng In .Range(AdrsOrgl, .Cells(.Rows.Count, ColNoOrgl).End(xlUp))
            If ColrMisgVal = "Yes" And aDicMisgVal(Rng.Val).Exists Then
                Rng.Interior.ColorIndex = 38
            End If
        Next
    End With
 
 
 
 '________________________________________________________________________________________________________
 'Code -
    
    RngList.RemoveAll
 
 

 '______________________________________________________________________________________________________________
 'Code -
    
2000:

    If ErrMsg1 = "Yes" And ErrMsg2 = "Yes" Then
        MsgBox "There is an issue with both the Original and Update data."
    ElseIf ErrMsg1 = "Yes" Then
        MsgBox "There is an issue with the Original data."
    ElseIf ErrMsg2 = "Yes" Then
        MsgBox "There is an issue with the Update data."
    End If
    
    



 '_________________________________________________________________________________________________________________
 'Turn on alerts and screen updates, and calculate
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    Calculate



 '_________________________________________________________________________________________________________________
 'End of the subroutine/macro
 
 
 
End Function