Solved Compare Columns on Different Worksheets and Add Missing Data

Microsoft Excel 2010 - complete product...
August 4, 2015 at 05:29:01
Specs: Windows 10
Hi,

I have (2) Worksheets I would like to compare the columns and add missing employees to the main worksheet and highlight any employees that no longer on the 2nd sheet.

Sample - Sheet 1 "Plant 1 - PA's"

              Column A                   Column B                                      Column C          
Row 3)   Employee Name        Employee ID                                 Start Date
Row 4)   Employee 1               (VLOOKUP Formula to Sheet 2)   (VLOOKUP Formula to Sheet 2)
Row 5)   Employee 2               (VLOOKUP Formula to Sheet 2)   (VLOOKUP Formula to Sheet 2)
Row 6)   Employee 3               (VLOOKUP Formula to Sheet 2)   (VLOOKUP Formula to Sheet 2)
Row 7)   Employee 4               (VLOOKUP Formula to Sheet 2)   (VLOOKUP Formula to Sheet 2)

Sample - Sheet 2 "Employee List Query"

              Column A                   Column B                                      Column C          
Row 1)   Employee Name        Employee ID                                 Start Date
Row 2)   Employee 1               12345                                            3/11/13 
Row 3)   Employee 3               87321                                            8/6/12
Row 4)   Employee 4               36554                                           10/27/14
Row 5)   Employee 5               97637                                           8/10/15

In the above example, I would like to be able to add Employee 5 from the "Employee List Query" to the bottom of the "Plant 1 - PA's" sheet along with the VLOOKUP formulas in Columns B & C.

I would also like to highlight Employee 2 on the "Plant 1 - PA's" as it has been removed form the "Employee List Query" sheet.

Hopefully, this makes sense and is possible??

Thank you,
Sandi


See More: Compare Columns on Different Worksheets and Add Missing Data

Report •


#1
August 6, 2015 at 05:31:49
✔ Best Answer
Hi,

Here is an example of how i would do it, usually others will have a much cleaner and probably better way of coding the solution, however this is my way of doing it.

Hopefully DerbyDad can provide a solution too.

There are two method which you will need to call

1) CopyMissingEmployee
This will call IsOnOtherList and check if the employee exists on the other list, if not then the entire row is copied to sheet 1

2) HiglightRemoved
This will call IsMissing and will highlight any employees on sheet 1 where they do not appear on sheet 2.

Hope this helps

Private Sub CopyMissingEmployee()

    Dim URange, LRange
    Dim BCell As Range
    Dim NextRow
    
    Set URange = Sheet2.Range("A2")
    Set LRange = Sheet2.Range("A" & Rows.Count).End(xlUp)
    
    For Each BCell In Sheet2.Range(URange, LRange)
        
        If IsOnOtherList(BCell.Value) = False Then
            
            BCell.EntireRow.Copy
            
            NextRow = Sheet1.Range("A" & Rows.Count).End(xlUp).Row
            
            Sheet1.Paste Sheet1.Range("A" & NextRow + 1)
            
        End If
    
    Next BCell

End Sub

Private Function IsOnOtherList(EmpID As String) As Boolean

    Dim URange, LRange
    Dim BCell As Range
    
    Set URange = Sheet1.Range("A2")
    Set LRange = Sheet1.Range("A" & Rows.Count).End(xlUp)
    
    For Each BCell In Sheet1.Range(URange, LRange)

        If BCell.Value = EmpID Then
            IsOnOtherList = True
            Exit For
        Else
            IsOnOtherList = False
        End If

    Next BCell

End Function

Private Sub HiglightRemoved()

    Dim URange, LRange
    Dim BCell As Range
    Dim NextRow
    
    Set URange = Sheet1.Range("A2")
    Set LRange = Sheet1.Range("A" & Rows.Count).End(xlUp)
    
    For Each BCell In Sheet1.Range(URange, LRange)
        
        If IsMissing(BCell.Value) = True Then
            
            'BCell.EntireColumn.Interior.Color = vbYellow
            BCell.EntireRow.Interior.Color = vbYellow
            
        End If
    
    Next BCell

End Sub

Private Function IsMissing(EmpID As String) As Boolean

    Dim URange, LRange
    Dim BCell As Range
    
    Set URange = Sheet2.Range("A2")
    Set LRange = Sheet2.Range("A" & Rows.Count).End(xlUp)
    
    For Each BCell In Sheet2.Range(URange, LRange)
    
        If BCell.Value <> EmpID Then
            IsMissing = True
        Else
            IsMissing = False
            Exit For
        End If

    Next BCell

End Function


Report •
Related Solutions


Ask Question