Microsoft Excel 2010 - complete product...

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/15In 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

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 12) 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

Ask Your Question

Weekly Poll

Would you be willing to go on a SpaceX trip around the moon?

Discuss in The Lounge

Poll History