VBA - If unique value (ID) found in list, copy row to sheet2, if duplicate ID found, then paste first instance (based on date) to sheet 2, etc..

[DK643]

Hi VBA masters.
I need some help with some more complex if then statements and movement of data amongst tabs based on those if then statements. Thank you in advance!!

The short: I seek to take a source file and split it up based on two scenarios.
1. If an Employee ID shows up once in Column C, then copy and paste entire row to Sheet 2.
2. If an Employee ID shows up more than once in Column C, then determine the instance with the oldest date in Column J (Grant Date), and copy and paste into Sheet 2, then the next oldest instance is copy and pasted into Sheet 3, then sheet 4, Etc. (There will never be more than 4 instances)


The Long:

I receive a file that contains a list of employees who have restricted stock that will vest on a particular date. (That date is titled "Purchase Date" and is in Column S (See below)
Duplicate employee IDs occur often as employees are granted stock on different dates and years, but the grants sometimes vest on the same date. An example is in the table below. See employee 2345 has 3 different grants dates that all vest on the same date in February. We must split these out into separate payrolls that are in order of grant date so taxes are calculated properly for each grant.

So, I was able to write a macro that splits the source file by grant date,...but that doesn't help my payroll team. That creates numerous tabs which equates to numerous off-cycle payrolls, reconciliations, etc. and just makes their job harder. We need to consolidate the data to limit the number of payroll runs the team must process. To do this, we need Sheet 2 to contain any employee who has just one vesting which could be 2000+ people). This sheet 2 must also include the first instance of any duplicates. Then all second instances go into sheet 3, all 3rd instances into sheet 4, etc.
In the below example sheet 2 will have employee 1234, first instance (grant date 6/30/2019) for employee 2345 and first instance of employee 6789 (Grant date 7/31/2019). Sheet 3 will be Employee 2345 instance 2 and employee 6789 instance 2, Sheet 4 will have 2345 instance 3. Notice the grant dates can be different by employee on each sheet. That is ok.

Thank you so much for any help you can provide.

Column B	Column J	Column S	Column W
Employee ID	Grant Date	Purchase Date	Qty-Vesting
1234	6/30/2019	2/28/2022	50
2345	6/30/2019	2/28/2022	25
2345	10/31/2019	2/28/2022	25
2345	1/31/2020	2/28/2022	25
6789	7/31/2019	2/28/2022	100
6789	7/31/2021	2/28/2022	100

 

[DanteAmor]

Hi and welcome to MrExcel

(There will never be more than 4 instances

Considering that.
Your data in sheet1, starting at A1, the results in sheets sheet2, sheet3, sheet4 and sheet5.

Try this:

Sub Macro1()
  Dim sh1 As Worksheet
  Dim i As Long, j As Long, k As Long, lr As Long, n As Long
  Dim a As Variant, b As Variant, c As Variant, d As Variant, e As Variant
  Dim dic As Object, di2 As Object
  Dim rng As Range
  
  Set dic = CreateObject("Scripting.Dictionary")
  Set di2 = CreateObject("Scripting.Dictionary")
  Set sh1 = Sheets("Sheet1")
  lr = sh1.Range("C" & Rows.Count).End(3).Row
  With sh1.Range("A1:W" & lr)
    .Sort key1:=sh1.Range("C1"), order1:=xlAscending, _
          key2:=sh1.Range("J1"), order2:=xlAscending, Header:=xlYes
    a = .Value
    ReDim b(1 To UBound(a, 1), 1 To UBound(a, 2))
    ReDim c(1 To UBound(a, 1), 1 To UBound(a, 2))
    ReDim d(1 To UBound(a, 1), 1 To UBound(a, 2))
    ReDim e(1 To UBound(a, 1), 1 To UBound(a, 2))
  End With
  
  For i = 2 To UBound(a, 1)
    If Not dic.exists(a(i, 3)) Then
      n = 2
      di2(n) = di2(n) + 1
      j = di2(n)
    Else
      n = dic(a(i, 3)) + 1
      j = di2(n) + 1
    End If
    dic(a(i, 3)) = n
    di2(n) = j
    Select Case n
      Case 2
        For k = 1 To UBound(a, 2)
          b(j, k) = a(i, k)
         Next
      Case 3
        For k = 1 To UBound(a, 2)
          c(j, k) = a(i, k)
        Next
      Case 4
        For k = 1 To UBound(a, 2)
          d(j, k) = a(i, k)
        Next
      Case 5
        For k = 1 To UBound(a, 2)
          e(j, k) = a(i, k)
        Next
    End Select
  Next
  
  Sheets("Sheet2").Range("A2").Resize(UBound(b, 1), UBound(b, 2)).Value = b
  Sheets("Sheet3").Range("A2").Resize(UBound(c, 1), UBound(c, 2)).Value = c
  Sheets("Sheet4").Range("A2").Resize(UBound(d, 1), UBound(d, 2)).Value = d
  Sheets("Sheet5").Range("A2").Resize(UBound(e, 1), UBound(e, 2)).Value = e

End Sub

 

[DK643]

DanteAmor, Thank you so much for your help. Sorry for the delay, Our source file will be dynamic so I have some additional requirements that I can't figure out.

I ran your code and the employee #1 split out properly into Sheet 2 and Sheet 3. Then employee #2 split out onto sheet 4 and 5. I was originally looking for the first instance of every employee to be in Sheet 2 and second instance for all employees in Sheet three. Sorry that I was not clear on my request. With that said...

With changing requirements and a fear that there will be inconsistent data in the grant naming convention, I seek to simplify the process to mitigate risk. Hopefully you can still help and sorry for the change. I wrote a script that splits out by Grant date alone but to run the code it takes about 2 minutes. Your code was almost instantaneous, so seek your guidance to write a more script.

New iteration of the request, and thank you again for your help!! One requirement that has changed, is the source file may include additional columns in the future. These will be added at random locations throughout the file, so instead of just using column C or column J, I think we now have to go based on column header name in row 1. If it is ok, I will provide the Column Header name. I Hope that is ok. If we can't do that, that's fine. But wanted to see if that is possible. I found one piece of code online, but I couldn't get it to work.

New requirements. Again thank you for all your help.
00. Remove all International employees from the source file (Source file will be in tab named Source) and paste header and only US employees into Sheet1. Details on this are below in the section called "Want not a need". I do this manually today before the process starts.
0. Delete contents on all destination sheets (I believe this will go out to sheet 8, but I can always add to your code to expand to new sheets)
1. Copy header from Sheet1 and paste in destination sheet.
2. In USA Source data (aka Sheet1), find the column header in row 1 named "Grant Date", (Currently that is column L)
3. In the "Grant Date" column, Identify the oldest grant date (This will be in short date format (2/28/2019). No leading zero on months...(ie Feb =2, not 02) Not sure if that matters.
3. Any row that has the oldest grant date, copy and paste the entire row into Sheet2 (after the sheet has been cleared of content and header added)
This will result with Sheet 2 containing all employees that have a grant with the oldest date. (NOTE - the last column in the file is Column AZ today.
4. Next, repeat the process by finding the next oldest grant date and paste all identified rows into destination Sheet4. (I am Skipping Sheet3. We will have to manually move some rows from sheet2 to sheet 3 because grant IDs and not consistent enough to add a systematic process)
5. Next, repeat process until all grant dates have been split out. ( I Don't foresee this ever going past 8 separate sheets, but I have up to Sheet10 available just in case.)

From a process perspective, because grant IDs are not consistent, this is the best approach I could think of to systematically split by grant date, then manually split out any grants with the same grant date but have different grant IDs.

WANT, not a need: In 00 above, I mention removing all Non US employees. This is not required, but would make everyone's life easier and completely remove risk of manually deleting rows...... Non-US employees are identified by having data in a column with a header named "Tax 8 Desc." in row 1. Can you write into the process as an initial step to remove all international employees and create a new Source file that includes only USA employees. I would assume this would be an if then statement that says, something of the sort: "IF the source file has any data in the column named "Tax 8 Desc.", Do not send to Sheet1, all other rows copy and paste to Sheet 1.

Thank you again for your help. My code as it stands today is very simple. I manually type in the grant dates in a master tab. The VBA identifies that date and searches for that date in sheet 1 in a particular column, if that date is found, it copies and pastes that entire row to a destination sheet 2, then it follows the same process for the next date on the master. It works,...but I couldn't get the delete contents to work properly, So I manually have to delete the old content before every run, which adds considerable risk to the process. Thank you again!!

 

[DanteAmor]

Then employee #2 split out onto sheet 4 and 5.

That is not right. My code separates employee 2 ("2345") into sheets 2, 3 and 4

I was originally looking for the first instance of every employee to be in Sheet 2 and second instance for all employees in Sheet three. Sorry that I was not clear on my request. With that said...

And that does my code.
---

New iteration of the request

It is a new requirement. Create a new thread, as a new macro is required.

 

[DK643]

Ok. Will do. Thank you.

 

[DK643]

I will also validate this code so I can mark your code with a check mark.

 

[DK643]

Hi DanteAmor,
Thank you again for all your help.
I went back to the original script you wrote and original columns I provided and Yes. It works perfectly.

One thing I would note for anyone that reads this thread, is that when the code pastes the values into the destination sheets, the column headers do not populate, and the values are entered into row 2, not row 1. (This worked for my needs. Just want the user to be aware, so you can adjust your script if you do need column headers)

Thank you again. The script was fast, efficient and works great! If possible, please take a look at the new requirements that are now in the thread named:

VBA - Split Source file-Find oldest date in column. Copy all rows with date to new sheet, Repeat on next oldest date. Also, remove some unwanted data.​

Thank you again!!!
You Rock!!

 

[DanteAmor]

Glad I was able to help!