Modify VBA Code in a Function which Compares List and Updates, but exclude certain words and cells filled with color

[OilEconomist]

Thanks in advance for any assistance given.

The code currently works, but I would like to modify it to where if the cell/entry in the "ShtNmUpdt" is excluded if it has:
(1) a certain entry specified from a list. Maybe put into an Array and passed to the function.
(2) Filled with color
(a) any color
(b) a list of specified colors which can be passed through an array


List of words to exclude
I guess to do this I could pass that list through an array like ValExcArr() where the Function would change to

Function CmprListsNAddF(ShtNmOrgl As String, ShtNmUpdt As String, ColHdgNm As String, ValExcArr() as Variant) As Variant

, but I don't know how to change the rest of the code.

Color(s) to be excluded
In terms of color, I would like to be able to have the flexibility to specify if it's filled with a specific color or is filled with any color the function could change to something like

Function CmprListsNAddF(ShtNmOrgl As String, ShtNmUpdt As String, ColHdgNm As String, ValExcArr() as Variant, ClrExcAny as String, ClrExcArr() as Variant) As Variant

, but once again I don't know how to change the rest of the code.

ClrExclAny if "Yes" would exclude any filled cell. If it stated anything else, it would be ignored.
ClrExcArr() could maybe pass the colors (RGB stored a string) through the function. If ClrExclAny = "Yes", then I would like this to get ignored.

One last question is, what if there were no words or colors to be ignored? How would I change the Sub? Just have a single dimension arrays with blank values?


The line in the Function code that I think needs to be changed is as follows and of course I could be wrong.

    With Sheets(ShtNmUpdt)
        For Each Rng In .Range(AdrsUpdt, .Cells(.Rows.Count, ColNoUpdt).End(xlUp))
            If Not RngList.Exists(Rng.Value) Then
                Sheets(ShtNmOrgl).Cells(Sheets(ShtNmOrgl).Rows.Count, ColNoOrgl).End(xlUp).Offset(1, 0) = Rng
            End If
        Next
    End With

to something like this

With Sheets(ShtNmUpdt)
        For Each Rng In .Range(AdrsUpdt, .Cells(.Rows.Count, ColNoUpdt).End(xlUp))
            If Rng.Value = ValExcArr() or ClrExcAny = "Yes"
                    'do nothing so it will be excluded from the list to be transferred
            ElseIf Rng.Value = ValExcArr() or Rng.Color = ClrExcArr()
                    'do nothing so it will be excluded from the list to be transferred
            ElseIf Not RngList.Exists(Rng.Value) Then
                Sheets(ShtNmOrgl).Cells(Sheets(ShtNmOrgl).Rows.Count, ColNoOrgl).End(xlUp).Offset(1, 0) = Rng
            End If
        Next
    End With

Current code:

'**********************************************************************************************************
'Function which will compare two lists and add the missing ones from ShtNmUpdt to ShtNmOrgl.

Function CmprListsNAddF(ShtNmOrgl As String, ShtNmUpdt As String, ColHdgNm As String) As Variant

 'Function CompareListsNAdd
    'ShtNmOrgl (String) - The sheet with the original data which will be updated
    'ShtNmUpdt (String) - The sheet with the data with updates. It will be transferred to the ShtNmOrgl
    'ColHdgNm (String) - The name of the column Heading with the data to be updated
 

 '_______________________________________________________________________________________________________________
 '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 Variants
     Dim ColHdgNmOrgl As Variant
     Dim ColHdgNmUpdt As Variant
    
    
    'Dim Timer variables
     Dim TimerCount As Long
     Dim BenchMark As Double
 
 
 
 '_______________________________________________________________________________________________________________
 'Code - Timer Benchmark
    'BenchMark = Timer
 
 
 
 '______________________________________________________________________________________________________________
 'Code - LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Set RngList = CreateObject("Scripting.Dictionary")



 '______________________________________________________________________________________________________________
 'Code - Column Heading in Original Sheet
    
    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
        
 
 
 '______________________________________________________________________________________________________________
 'Code - Column Heading in sheet with updated data

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
        
        
 '______________________________________________________________________________________________________________
 'Code -
    
    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
 
 
 
 '______________________________________________________________________________________________________________
 'Code -
 
    With Sheets(ShtNmUpdt)
        For Each Rng In .Range(AdrsUpdt, .Cells(.Rows.Count, ColNoUpdt).End(xlUp))
            If Not RngList.Exists(Rng.Value) Then
                Sheets(ShtNmOrgl).Cells(Sheets(ShtNmOrgl).Rows.Count, ColNoOrgl).End(xlUp).Offset(1, 0) = Rng
            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
    
    


'_________________________________________________________________________________________________________________
 'Place cursor in Workbook, Sheet, and Cell

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

 
 '_________________________________________________________________________________________________________________
 'Timer
  
    'MsgBox TimerCount - BenchMark



 '_________________________________________________________________________________________________________________
 'End of the subroutine/macro
 
 
 
End Function