Find missing values between two columns with VBA

[Eraaz]

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 column.

I can't copy the whole column because it is linked to a Sharepoint.

This is my code right now.

Sub LinkSheetToSharePoint()  
  SiteURL = "myURL"     'URL to site (without trailing slash)
  TargetSheetName = "Feuil1"                                            'Target Excel sheet name
  ViewGUID = "{B3C3255D-40A3-4583-8461-A54EA8237FFB}"                   'View GUID (can be obtained from the Edit View page URL)
  ListName = "Supplier"                                                'List to be linked


  Set TableList = ThisWorkbook.Sheets(TargetSheetName).ListObjects.Add(SourceType:=xlSrcExternal, _
  Source:=Array(SiteURL & "/_vti_bin", ListName, ViewGUID), _
  LinkSource:=True, _
  Destination:=ThisWorkbook.Sheets(TargetSheetName).Range("A1"))
  TableList.Name = ListName
  
End Sub


Sub RecoverData()
'Find "Name" in Row 1
Dim x As Workbook
 
    '## Open both workbooks first:
    Set x = Workbooks.Open(Application.ActiveWorkbook.Path & "\Suppliers ex Morpho.xlsx")
 
    With x.Sheets("Database").Rows(1)
        Set t = .Find("Vendor name", lookat:=xlPart)
        'If found, copy the column to Sheet 2, Column A
        'If not found, present a message
        If Not t Is Nothing Then
            Columns(t.Column).EntireColumn.Copy _
            Destination:=ThisWorkbook.Sheets("Feuil2").Range("A1")
        Else: MsgBox "Column Name Not Found"
        End If
    End With
    With x.Sheets("Database").Rows(1)
        Set b = .Find("Vendor account", lookat:=xlPart)
        'If found, copy the column to Sheet 2, Column A
        'If not found, present a message
        If Not b Is Nothing Then
            Columns(b.Column).EntireColumn.Copy _
            Destination:=ThisWorkbook.Sheets("Feuil2").Range("B1")
        Else: MsgBox "Column Name Not Found"
        End If
    End With
  x.Close
End Sub

I tryied to be as clear as possible, but if it is not, tell me i will try to do it another way.
Thank you.

 

[mumps]

Glad it worked for you.

 

[OilEconomist]

Try:

Sub CompareLists()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim Rng As Range, RngList As Object
    Set RngList = CreateObject("Scripting.Dictionary")
    With Sheets("Feuil1")
        For Each Rng In .Range("A2", .Range("A" & .Rows.Count).End(xlUp))
            If Not RngList.Exists(Rng.Value) Then
                RngList.Add Rng.Value, Nothing
            End If
        Next
    End With
    With Sheets("Feuil2")
        For Each Rng In .Range("A2", .Range("A" & .Rows.Count).End(xlUp))
            If Not RngList.Exists(Rng.Value) Then
                Sheets("Feuil1").Cells(Sheets("Feuil1").Rows.Count, "A").End(xlUp).Offset(1, 0) = Rng
            End If
        Next
    End With
    RngList.RemoveAll
    Application.ScreenUpdating = True
End Sub

@mumps Once again thanks for this.

I have a few questions so if I need to start a new thread, please just let me know. I rewrote the code into a function since I am going to use it many times in set of Macros within a Workbook. I also changed some of the code to where the start rows and columns may vary.

Questions:
(1) use .Cells method versus .Range.
(2) I would be able to omit certain values from transferring to update the Original list if it is a certain value or filled with color. I used a function, so understandably, you may have to include all the unwanted values in the function. An easier method might be to be able to pass "Yes" (omit cells filled with color) or "No" through the function.

(1) First question - modify code to use .Cells method versus .Range.

.Cells

versus

 .Range

in the following line of code. Here are the two lines I would like to change:

Set ColHdgNmOrgl = .Cells.Find(What:=ColHdgNm, LookIn:=xlFormulas, LookAt _
                :=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
                False, SearchFormat:=False)

Set ColHdgNmUpdt = .Cells.Find(What:=ColHdgNm, LookIn:=xlFormulas, LookAt _
                :=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
                False, SearchFormat:=False)

Basically I want to avoid having to convert the number to a letter which I do as

ColLetOrgl = Split(Cells(1, ColNoOrgl).Address, "$")(1)

 ColLetUpdt = Split(Cells(1, ColNoUpdt).Address, "$")(1)

Question 2 - (2) be able to omit certain values from transferring to update the Original list if it is a certain value or filled with color. I used a function, so understandably, you may have to include all the unwanted values in the function versus passing it through the function. An easier method might be to be able to pass "Yes" (omit cells filled with color) or "No" (do not omit cells filled with color) through the function.

'**********************************************************************************************************
'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 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 Resume Next
        Set ColHdgNmOrgl = .Cells.Find(What:=ColHdgNm, LookIn:=xlFormulas, LookAt _
                :=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
                False, SearchFormat:=False)
        
        AdrsOrgl = ColHdgNmOrgl.Address
        
        RowNoOrgl = ColHdgNmOrgl.Row
        ColNoOrgl = ColHdgNmOrgl.Column
        
        ColLetOrgl = Split(Cells(1, ColNoOrgl).Address, "$")(1)
        
    End With
        
        'MsgBox "(" & OrglAdrs & ", " & OrglRowNo & ", " & OrglColNo & ")"
 
 
 '______________________________________________________________________________________________________________
 'Code - Column Heading in sheet with updated data
    
    With Sheets(ShtNmUpdt)
        
        On Error Resume Next
        Set ColHdgNmUpdt = .Cells.Find(What:=ColHdgNm, LookIn:=xlFormulas, LookAt _
                :=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
                False, SearchFormat:=False)
        
        AdrsUpdt = ColHdgNmUpdt.Address
        
        RowNoUpdt = ColHdgNmUpdt.Row
        ColNoUpdt = ColHdgNmUpdt.Column
        
        ColLetUpdt = Split(Cells(1, ColNoUpdt).Address, "$")(1)
        
    End With
        
        'MsgBox "(" & OrglAdrs & ", " & OrglRowNo & ", " & OrglColNo & ")"
 
 
 '______________________________________________________________________________________________________________
 'Code -
    
    With Sheets(ShtNmOrgl)
        For Each Rng In .Range(AdrsOrgl, .Range(ColLetOrgl & .Rows.Count).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, .Range(ColLetUpdt & .Rows.Count).End(xlUp))
            If Not RngList.Exists(Rng.Value) Then
                Sheets(ShtNmOrgl).Cells(Sheets(ShtNmOrgl).Rows.Count, ColLetOrgl).End(xlUp).Offset(1, 0) = Rng
            End If
        Next
    End With
    
    
    
 '______________________________________________________________________________________________________________
 'Code -
    
    RngList.RemoveAll
 
 
 
 '_________________________________________________________________________________________________________________
 '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

 

[mumps]

Since this is a different set of circumstances, I suggest that you start a new thread.