VBA: Splitting date ranges by date

[RusselJ]

Hi all

I was hoping someone can help me with some VBA to achieve what I am looking for.

Basically on Sheet 1 the users enters a list of names in Column A and then dates of employment in Columns B to C. So in the below example Jack was employed from 01/01/1980 until 31/12/1985.

Sheet 1: All managers

[TABLE="class: grid, width: 284"]
<tbody>[TR]
[TD][/TD]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]Manager[/TD]
[TD]Date From[/TD]
[TD]Date To[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]Jack[/TD]
[TD]01/01/1980[/TD]
[TD]31/12/1985[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]John[/TD]
[TD]01/01/1986[/TD]
[TD]31/12/1995[/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD]Jill[/TD]
[TD]01/01/1996[/TD]
[TD]31/12/1998[/TD]
[/TR]
</tbody>[/TABLE]

I need some VBA which when run will achieve the following based upon the data entered on Sheet 1:

• Populate Sheet 2 with managers before 01/01/1990
• Populated Sheet 3 with managers after 01/01/1990

I have set out what should be populated on Sheet 2 and 3 below based on the current example.

Note that John’s employment is from 01/01/1986 – 31/12/1995 which spans both pre and post 1990. In this circumstance the entry should be automatically split at 31/12/1989 on Sheet 2 and the remainder of the period should be populated on Sheet 3 as beginning from 01/01/1990 as per the below example.

Sheet 2: Before 1990

[TABLE="class: grid, width: 284"]
<tbody>[TR]
[TD][/TD]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]Manager[/TD]
[TD]Date From[/TD]
[TD]Date To[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]Jack[/TD]
[TD]01/01/1980[/TD]
[TD]31/12/1985[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]John[/TD]
[TD]01/01/1986[/TD]
[TD]31/12/1989[/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

Sheet 3: After 1990

[TABLE="class: grid, width: 284"]
<tbody>[TR]
[TD][/TD]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]Manager[/TD]
[TD]Date From[/TD]
[TD]Date To[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]John[/TD]
[TD]01/01/1990[/TD]
[TD]31/12/1995[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]Jill[/TD]
[TD]01/01/1996[/TD]
[TD]31/12/1998[/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]


Points to note:

1. The number of managers on Sheet 1 could vary between 1 – 30.
2. The dates will never overlap as there can only be one “manager” for one period.

Thank you for your help!

R

 

[AlphaFrog]

[color=darkblue]Sub[/color] Manager_Split()
    [color=darkblue]Dim[/color] d [color=darkblue]As[/color] [color=darkblue]Date[/color]
    d = DateSerial(1990, 1, 1)
    [color=darkblue]With[/color] Sheets("Sheet1").Range("A1").CurrentRegion
        .AutoFilter 2, "<" & d
        .Copy Sheets("Sheet2").Range("A1")
        Sheets("Sheet2").Range("C" & Rows.Count).End(xlUp).Value = d - 1
        .AutoFilter
        
        .AutoFilter 3, ">=" & d
        .Copy Sheets("Sheet3").Range("A1")
        Sheets("Sheet3").Range("B2").Value = d
        
        .Parent.AutoFilterMode = [color=darkblue]False[/color]
    [color=darkblue]End[/color] [color=darkblue]With[/color]
[color=darkblue]End[/color] [color=darkblue]Sub[/color]

 

[RusselJ]

[COLOR=darkblue]Sub[/COLOR] Manager_Split()
    [COLOR=darkblue]Dim[/COLOR] d [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Date[/COLOR]
    d = DateSerial(1990, 1, 1)
    [COLOR=darkblue]With[/COLOR] Sheets("Sheet1").Range("A1").CurrentRegion
        .AutoFilter 2, "<" & d
        .Copy Sheets("Sheet2").Range("A1")
        Sheets("Sheet2").Range("C" & Rows.Count).End(xlUp).Value = d - 1
        .AutoFilter
        
        .AutoFilter 3, ">=" & d
        .Copy Sheets("Sheet3").Range("A1")
        Sheets("Sheet3").Range("B2").Value = d
        
        .Parent.AutoFilterMode = [COLOR=darkblue]False[/COLOR]
    [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]

Hi AlphaFrog

Thank you very much for your suggestion.

Sorry to be a pain but is it possible to achieve this without using autofilter?

I also forgot to mention that the data on Sheet1 changes and sometimes there will be a date which exceeds 1990 and sometimes there won't.

Thanks

R

 

[AlphaFrog]

Sorry to be a pain but is it possible to achieve this without using autofilter?

Why not autofilter?

[COLOR=darkblue]Sub[/COLOR] Manager_Split()
    [COLOR=darkblue]Dim[/COLOR] d [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Date[/COLOR], v [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Variant[/COLOR], i [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR], j [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR], k [COLOR=darkblue]As[/COLOR] Long
    d = DateSerial(1990, 1, 1)
    v = Sheets("Sheet1").Range("A1").CurrentRegion.Value
    j = 1: k = 1
    
    [COLOR=green]'Headers[/COLOR]
    Sheets("Sheet1").Rows(1).Copy Sheets("Sheet2").Rows(1)
    Sheets("Sheet1").Rows(1).Copy Sheets("Sheet3").Rows(1)
    
    [COLOR=darkblue]For[/COLOR] i = 2 [COLOR=darkblue]To[/COLOR] [COLOR=darkblue]UBound[/COLOR](v, 1)
        
        [COLOR=darkblue]If[/COLOR] v(i, 2) < d [COLOR=darkblue]Then[/COLOR]
            j = j + 1
            Sheets("Sheet2").Cells(j, 1).Resize(, 3).Value = Application.Index(v, i, 0)
            [COLOR=darkblue]If[/COLOR] v(i, 3) >= d [COLOR=darkblue]Then[/COLOR] Sheets("Sheet2").Cells(j, 3).Value = d - 1
        [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
        
        [COLOR=darkblue]If[/COLOR] v(i, 3) >= d [COLOR=darkblue]Then[/COLOR]
            k = k + 1
            Sheets("Sheet3").Cells(k, 1).Resize(, 3).Value = Application.Index(v, i, 0)
            [COLOR=darkblue]If[/COLOR] v(i, 2) < d [COLOR=darkblue]Then[/COLOR] Sheets("Sheet3").Cells(k, 2).Value = d
        [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
        
    [COLOR=darkblue]Next[/COLOR] i
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]