Merge values from old sheet with new sheet and flag new entries

[covareo]

I have a task that is asked of my team every year that is very time-consuming. We get a listing of all employees that is missing key information that we manually update each year. I am hoping that you can help us to automate this process. We have a new list as the "Working" tab in an Excel file and last year's list as the "Old" tab in the same file (attached). I am hoping to have a formula or script that can search each Employee_Num from the "Working" tab for information on the "Old" tab, and if it's found, populate columns C, D, and E with any data found. Additionally, if the record is not found in "Old", mark column A on the "Working" sheet with an X so we can examine and confirm its a new hire. I have mocked this up in the "Result" tab.

The lookup value is the Employee_Num field. The first column is an automatically generated iterative counter and not important. If values exist in the "Working" tab they should be respected and kept as they are. Empty values are common and inconsistent.

Here is the "Working" Tab:

Employee-Update.xlsx
	A	B	C	D	E	F	G	H	I	J
1		New	Hire_Date	Type	Term_Date	Employee_Num	LastName	FirstName	Initial	Depend
2	1					001234567	La Rosa	Le Shawn	L	0
3	2					003456789	Wilson	Barbara	W	4
4	3					055527240	D'Angelo	Garett	S	2
5	4					011846457	McDough	Betty		0
6	5					016234437	Rinni	Joshua	M	0
7	6		2/1/21	PT	7/14/23	001423289	Olson	Enrique		2
8	7					001293213	Erickson	Kyle		0
Working

Here is the "Old" tab:

Employee-Update.xlsx
	A	B	C	D	E	F	G	H	I
1		Hire_Date	Type	Term_Date	Employee_Num	LastName	FirstName	Initial	Depend
2	1	6/14/12	FT		001234567	La Rosa	Le Shawn	L	0
3	2	2/24/92	FT		003456789	Wilson	Barbara	W	4
4	3	9/15/23	FT		055527240	D'Angelo	Garett	S	2
5	4		FT		011846457	McDough	Betty		0
6	5	3/13/21	FT		016234437	Rinni	Joshua	M	0
7	6	2/1/21	PT	7/14/23	001423289	Olson	Enrique		2
Old

Here is a mocked-up "Result" after the run:

Employee-Update.xlsx
	A	B	C	D	E	F	G	H	I	J
1		New	Hire_Date	Type	Term_Date	Employee_Num	LastName	FirstName	Initial	Depend
2	1		6/14/12	FT		001234567	La Rosa	Le Shawn	L	0
3	2		2/24/92	FT		003456789	Wilson	Barbara	W	4
4	3		9/15/23	FT		055527240	D'Angelo	Garett	S	2
5	4			FT		011846457	McDough	Betty		0
6	5		3/13/21	FT		016234437	Rinni	Joshua	M	0
7	6		2/1/21	PT	7/14/23	001423289	Olson	Enrique		2
8	7	X				001293213	Erickson	Kyle		0
Result

 

[skillilea]

I think this should do it.

Public Sub EmployeeTransfer()
    
    Dim wWs As Worksheet, oWs As Worksheet
    Dim ar As Variant
    Dim rng As Range
    Dim i As Long, x As Long
    Dim empNum As Long
    Dim empFnd As Boolean
    
    Set wWs = ThisWorkbook.Sheets("Working")
    Set oWs = ThisWorkbook.Sheets("Old")

    ar = oWs.Range("A1").CurrentRegion
    Set rng = wWs.Range("A1").CurrentRegion
    
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    
    For i = 2 To rng.Rows.Count   ' leave the header out
       empNum = rng(i, 6).Value
    
        ' loop to find out if in OLD
        For x = 1 To UBound(ar)
            If ar(x, 5) = empNum Then
                wWs.Cells(i, 3).Value = ar(x, 2)
                wWs.Cells(i, 4).Value = ar(x, 3)
                wWs.Cells(i, 5).Value = ar(x, 4)
            End If
        Next
        
        ' write new employee
        If Not empFnd Then
            wWs.Cells(i, 2).Value = "X"
        End If
        
        empFnd = False
    Next

    Application.EnableEvents = True
    Application.ScreenUpdating = True
     
    Set oWs = Nothing
    Set wWs = Nothing
End Sub

 

[skillilea]

Just tested it with data. Update this

        ' loop to find out if in OLD
        For x = 1 To UBound(ar)
            If ar(x, 5) = empNum Then
                empFnd = True  ' need to set the found value to TRUE
                wWs.Cells(i, 3).Value = ar(x, 2)
                wWs.Cells(i, 4).Value = ar(x, 3)
                wWs.Cells(i, 5).Value = ar(x, 4)
            End If
        Next

 

[covareo]

I think this should do it.

Public Sub EmployeeTransfer()
   
    Dim wWs As Worksheet, oWs As Worksheet
    Dim ar As Variant
    Dim rng As Range
    Dim i As Long, x As Long
    Dim empNum As Long
    Dim empFnd As Boolean
   
    Set wWs = ThisWorkbook.Sheets("Working")
    Set oWs = ThisWorkbook.Sheets("Old")

    ar = oWs.Range("A1").CurrentRegion
    Set rng = wWs.Range("A1").CurrentRegion
   
    Application.EnableEvents = False
    Application.ScreenUpdating = False
   
    For i = 2 To rng.Rows.Count   ' leave the header out
       empNum = rng(i, 6).Value
   
        ' loop to find out if in OLD
        For x = 1 To UBound(ar)
            If ar(x, 5) = empNum Then
                wWs.Cells(i, 3).Value = ar(x, 2)
                wWs.Cells(i, 4).Value = ar(x, 3)
                wWs.Cells(i, 5).Value = ar(x, 4)
            End If
        Next
       
        ' write new employee
        If Not empFnd Then
            wWs.Cells(i, 2).Value = "X"
        End If
       
        empFnd = False
    Next

    Application.EnableEvents = True
    Application.ScreenUpdating = True
    
    Set oWs = Nothing
    Set wWs = Nothing
End Sub

Seems super close but I get an error when I run on the real 1500 line spreadsheet - when I click debug it highlights the line:
empNum = rng(i, 6).Value

 

[skillilea]

Seems super close but I get an error when I run on the real 1500 line spreadsheet - when I click debug it highlights the line:
empNum = rng(i, 6).Value

Make empNum a variant type instead of Long. My guess is it's finding a non number.

 

[covareo]

Make empNum a variant type instead of Long. My guess is it's finding a non number.

That fixed the error but only writes an X in every row for column B. What if we disregard the X functionality and just copy values for every found Employee_Num? Thats the critical bit and we could always dedup to find new.

 

[skillilea]

That fixed the error but only writes an X in every row for column B. What if we disregard the X functionality and just copy values for every found Employee_Num? Thats the critical bit and we could always dedup to find new.

Scroll up. I added a fix after the first post. You need to change the 2nd For Loop. Make sure this line is in the found part: empFnd = True ' need to set the found value to TRUE

 

[mumps]

Try:

Sub CopyData()
    Application.ScreenUpdating = False
    Dim srcWS As Worksheet, desWS As Worksheet, v1 As Variant, v2 As Variant, i As Long, x As Variant, srcRng As Range
    Set srcWS = Sheets("Old")
    Set desWS = Sheets("Working")
    Set srcRng = srcWS.Range("E2", srcWS.Range("E" & Rows.Count).End(xlUp))
    v1 = srcWS.Range("B2", srcWS.Range("B" & Rows.Count).End(xlUp)).Resize(, 4).Value
    v2 = desWS.Range("F2", desWS.Range("F" & Rows.Count).End(xlUp)).Value
    For i = LBound(v2) To UBound(v2)
        x = Application.Match(v2(i, 1), srcRng, 0)
        If Not IsError(x) Then
            desWS.Range("C" & i + 1).Resize(, 3).Value = srcWS.Range("B" & x + 1).Resize(, 3).Value
        Else
            desWS.Range("B" & i + 1) = "X"
        End If
    Next i
    Application.ScreenUpdating = True
End Sub

 

[covareo]

Scroll up. I added a fix after the first post. You need to change the 2nd For Loop. Make sure this line is in the found part: empFnd = True ' need to set the found value to TRUE

I believe I did this before reposting? I used the following code:

Public Sub EmployeeTransfer()
   
    Dim wWs As Worksheet, oWs As Worksheet
    Dim ar As Variant
    Dim rng As Range
    Dim i As Long, x As Long
    Dim empNum As Variant
    Dim empFnd As Boolean
   
    Set wWs = ThisWorkbook.Sheets("Working")
    Set oWs = ThisWorkbook.Sheets("Old")

    ar = oWs.Range("A1").CurrentRegion
    Set rng = wWs.Range("A1").CurrentRegion
   
    Application.EnableEvents = False
    Application.ScreenUpdating = False
   
    For i = 2 To rng.Rows.Count   ' leave the header out
       empNum = rng(i, 6).Value
   
        ' loop to find out if in OLD
        For x = 1 To UBound(ar)
            If ar(x, 5) = empNum Then
                empFnd = True  ' need to set the found value to TRUE
                wWs.Cells(i, 3).Value = ar(x, 2)
                wWs.Cells(i, 4).Value = ar(x, 3)
                wWs.Cells(i, 5).Value = ar(x, 4)
            End If
        Next
       
        ' write new employee
        If Not empFnd Then
            wWs.Cells(i, 2).Value = "X"
        End If
       
        empFnd = False
    Next

    Application.EnableEvents = True
    Application.ScreenUpdating = True
    
    Set oWs = Nothing
    Set wWs = Nothing
End Sub

This marks every column B with an X and does not copy over the dates from the Old tab even when present.

Again I am fine (Would prefer) to not worry about the the X being added at all. Just copying the Dates when present and the PT/FT for Type when present would be super helpful and get the project done for us today instead of spending days on it! Super appreciate all your work so far!

 

[covareo]

I tried doing this with VLOOKUP, but it was always blank/FALSE like this VBA has returned - is it because they are dates being copied? I tried:

=IFERROR(VLOOKUP(E2, 'Old'!B:E, 2, FALSE), "")