Need help modifying an Excel VBA coded to add a check for new hires less that 90 days.

spittingfire · Nov 13, 2022

Hi All,

I have the below code that works well and basically no issues except now I would like to have a check for seniority. Basically, adding something in some statement like If Today - Seniority < 90 then "New_Hire" or something along those lines. I just inherited this code and not verse enough to make such a change.

And help will be greatly appreciated.

VBA Code:

'new
Sub test_file_run()
NumRow_proc = Worksheets("_proc").Range("A2", Worksheets("_proc").Range("A2").End(xlDown)).Rows.Count + 1
NumRow_Voyageur_Result = Worksheets("_Voyageur_Result").Range("B2", Worksheets("_Voyageur_Result").Range("B2").End(xlDown)).Rows.Count + 1
NumRow_time_off = Worksheets("_time_off").Range("B2", Worksheets("_time_off").Range("B2").End(xlDown)).Rows.Count + 1
Dim Weekx As Variant
Dim Y As Integer
Dim Lookuparray As Range
Dim myindex As Range
Set Lookuparray = Worksheets("_Voyageur_Result").Range("B2:B" & NumRow_Voyageur_Result)
Set myindex = Worksheets("_Voyageur_Result").Range("F2:Y" & NumRow_Voyageur_Result)
Dim to_Lookuparray As Range
Dim to_myindex As Range
Set to_myindex = Worksheets("_time_off").Range("F2:L" & NumRow_time_off)
Set to_Lookuparray = Worksheets("_time_off").Range("A2:A" & NumRow_time_off)
Dim i As Integer
Worksheets("_proc").Range("A2").End(xlDown)).Rows.Count + 1
Worksheets("_Voyageur_Result").Range("B2").End(xlDown)).Rows.Count + 1
Worksheets("_time_off").Range("B2").End(xlDown)).Rows.Count + 1


For Y = 2 To NumRow_proc
Debug.Print Worksheets("_proc").Cells(Y, 2) & "  -  " & i
Dim var As Range
Set var = Worksheets("_proc").Range("A" & Y)
x = 1
i = 8
Repeat:
If IsError(Application.Match(var, Lookuparray, 0)) Then
    Worksheets("_proc").Cells(Y, i).Resize(1, 10) = "No_Selection"
    i = 18
        Else
    If IsError(Application.Index(myindex, Application.Match(var, Lookuparray, 0), x)) Then
        Weekx = "No_Selection"
            Else:
        Weekx = Application.Index(myindex, Application.Match(var, Lookuparray, 0), x)
    End If
    Debug.Print "Weekx : " & Weekx
    
    
    If Weekx = "No_Selection" Then
        'Fill Function here
        Fill_us_No_Selection (Y)
            Else:
        Weekx_day = Application.Text(Weekx, "ddd")
        Debug.Print "Weekx_day : " & Weekx_day
        
        Select Case Weekx_day
            Case "Mon"
                Weekx_day_col = 1
            Case "Tue"
                Weekx_day_col = 2
            Case "Wed"
                Weekx_day_col = 3
            Case "Thu"
                Weekx_day_col = 4
            Case "Fri"
                Weekx_day_col = 5
            Case "Sat"
                Weekx_day_col = 6
            Case "Sun"
                Weekx_day_col = 7
        End Select
        
        Debug.Print "Weekx_day_col : " & Weekx_day_col
        If IsEmpty(Application.Index(to_myindex, Application.Match(var, to_Lookuparray, 0), Weekx_day_col)) Then
            x = x + 1
            Debug.Print "X : " & x
            If x = 21 Then GoTo Endit
            GoTo Repeat
                Else:
            Allotx = Application.Index(Worksheets("_Voyageur_Allot").Range("A2:F372"), Application.Match(CLng(CDate(Weekx)), Worksheets("_Voyageur_Allot").Range("A2:A372"), 0), 5)
            Debug.Print "Allotx : " & Allotx
    
            If CLng(Allotx) >= 8 Then
                var_row = Application.Match(CLng(CDate(Weekx)), Worksheets("_Voyageur_Allot").Range("A2:A372"), 0) + 1
                Worksheets("_Voyageur_Allot").Range("E" & var_row).Value = Worksheets("_Voyageur_Allot").Range("E" & var_row).Value - 8
                Worksheets("_proc").Cells(Y, i).Value = Weekx
                x = x + 1
                If x = 21 Then GoTo Endit
                Debug.Print "X : " & x
                i = i + 1
                Debug.Print Worksheets("_proc").Cells(Y, 2) & "  -  " & i
                If i = 18 Then GoTo Skipit
                GoTo Repeat
                    Else:
                Worksheets("_proc").Cells(Y, i).Value = "No_Allotment"
                x = x + 1
                If x = 21 Then GoTo Endit
                'i = i + 1
                If i = 18 Then GoTo Skipit
                    
                GoTo Repeat
            End If
            If x = 21 Then GoTo Endit
        End If
    End If
End If
Skipit:
Endit:
Debug.Print i
If i < 18 Then
    Worksheets("_proc").Cells(Y, i).Resize(1, 18 - i) = "No_Allotment"
End If
Next Y


End Sub

Function Fill_us_No_Selection(ByVal rowstart As Integer)
Dim j As Integer
For j = 8 To 17
Worksheets("_proc").Cells(rowstart, j).Value = "No_Selection"
Next j
End Function

I will like the seniority date be used from this sheet under the column C (Seniority_Date)

test_data.xlsm

A

B

C

D

E

F

G

H

I

J

K

L

M

1

ID

Name

Seniority_Date

MU

Days_Per_week

Mon

Tues

Wed

Thurs

Fri

Sat

Sun

Days worked

2

14417807

peter17

4/24/2006

2058

4

10:00

0:00

10:00

7

3

253022876

peter18

3/7/2011

2058

5

8:00

0:00

8:00

7

4

509647174

peter19

7/7/2014

2058

5

8:00

0:00

7

5

112457891

peter20

9/12/2014

2062

5

8:00

0:00

7

6

480168528

peter21

11/16/2015

2058

5

10:00

0:00

10:00

0:00

10:00

7

24756624

peter22

6/10/2016

2062

5

0:00

8:00

0:00

7

8

309738752

peter11

7/22/2016

2062

5

8:00

0:00

8:00

7

9

690627818

peter12

8/19/2016

2062

5

8:00

0:00

8:00

7

10

695256908

peter13

8/26/2016

2058

5

0:00

8:00

0:00

7

11

912265825

peter14

11/18/2016

2062

5

0:00

8:00

0:00

7

12

998320692

peter15

3/26/2018

2058

5

0:00

8:00

0:00

7

13

245797967

peter16

6/18/2018

2058

5

0:00

8:00

0:00

7

14

844973625

peter1

11/5/2018

2062

5

0:00

8:00

0:00

7

15

233069302

peter2

11/12/2018

2058

5

8:00

0:00

8:00

7

16

132674823

peter3

2/18/2019

2062

5

0:00

8:00

0:00

7

17

446466105

peter4

2/18/2019

2062

5

8:00

0:00

8:00

7

18

565090917

peter5

3/19/2019

2062

5

8:00

0:00

8:00

7

19

494170342

peter6

4/16/2019

2058

5

8:00

0:00

8:00

7

20

9659517

peter7

12/10/2019

2058

5

0:00

8:00

0:00

7

21

443968955

peter8

12/10/2019

2058

5

10:00

0:00

10:00

7

22

277173473

peter9

3/23/2020

2062

4

8:00

0:00

8:00

7

23

498138869

peter10

7/20/2020

2058

4

8:00

0:00

8:00

7

24

53100

peter

11/1/2022

2058

4

8:00

0:00

8:00

7

_time_off

Cell Formulas
Range	Formula
M2:M24	M2	=COUNT(F2:L2)

Cells with Data Validation
Cell	Allow	Criteria
A1	Any value

When I run the code I get the below results

test_data.xlsm

A

B

C

D

E

F

G

H

I

J

K

L

M

N

O

P

Q

1

ID

Name

TOG

TOG_Name

ID_MU

Name_MU

Date_seniority

Day 1

Day 2

Day 3

Day 4

Day 5

Day 6

Day 7

Day 8

Day 9

Day 10

2

14417807

peter17

2011

4/24/06

7/30/2023

7/31/2023

8/1/2023

8/2/2023

8/3/2023

8/6/2023

8/7/2023

10/30/2023

10/31/2023

10/1/2023

3

253022876

peter18

2011

3/7/11

12/1/2023

12/2/2023

11/30/2023

12/29/2023

11/24/2023

11/25/2023

11/28/2023

1/3/2023

1/4/2023

10/21/2023

4

509647174

peter19

2011

7/7/14

3/26/2023

7/5/2023

7/6/2023

12/31/2023

12/28/2023

12/27/2023

12/26/2023

12/24/2023

3/27/2023

7/27/2023

5

112457891

peter20

2011

9/12/14

7/31/2023

8/1/2023

8/2/2023

8/3/2023

8/7/2023

10/30/2023

10/31/2023

12/24/2023

2/14/2023

2/15/2023

6

480168528

peter21

2011

11/16/15

6/24/2023

6/23/2023

7/15/2023

7/14/2023

2/14/2023

3/15/2023

1/28/2023

7/29/2023

7/13/2023

6/22/2023

7

24756624

peter22

2011

6/10/16

1/12/2023

5/14/2023

6/18/2023

12/24/2023

11/22/2023

12/26/2023

4/10/2023

3/19/2023

3/20/2023

3/21/2023

8

309738752

peter11

2011

7/22/16

2/15/2023

2/12/2023

5/22/2023

5/21/2023

5/7/2023

5/8/2023

10/29/2023

10/26/2023

11/26/2023

7/16/2023

9

690627818

peter12

2011

8/19/16

12/24/2023

7/2/2023

8/13/2023

7/9/2023

6/4/2023

6/11/2023

8/20/2023

7/23/2023

6/25/2023

8/27/2023

10

695256908

peter13

2011

8/26/16

5/4/2023

5/5/2023

11/21/2023

2/16/2023

10/28/2023

6/13/2023

6/14/2023

6/15/2023

6/16/2023

6/17/2023

11

912265825

peter14

2011

11/18/16

6/10/2023

9/27/2023

5/11/2023

7/17/2023

7/18/2023

7/19/2023

7/20/2023

7/21/2023

11/24/2023

11/25/2023

12

998320692

peter15

2011

3/26/18

1/14/2023

2/11/2023

2/25/2023

3/11/2023

3/25/2023

4/8/2023

4/22/2023

5/6/2023

5/20/2023

6/3/2023

13

245797967

peter16

2011

6/18/18

3/3/2023

3/4/2023

3/7/2023

12/26/2023

12/27/2023

11/24/2023

8/8/2023

9/2/2023

7/5/2023

10/6/2023

14

844973625

peter1

2011

11/5/18

2/19/2023

2/22/2023

2/23/2023

9/3/2023

9/6/2023

9/7/2023

1/4/2023

1/5/2023

7/10/2023

7/12/2023

15

233069302

peter2

2011

11/12/18

5/11/2023

3/12/2023

3/13/2023

12/26/2023

12/27/2023

12/28/2023

11/1/2023

11/2/2023

7/18/2023

7/19/2023

16

132674823

peter3

2011

2/18/19

11/16/2023

6/1/2023

6/5/2023

8/14/2023

5/28/2023

2/16/2023

4/10/2023

11/19/2023

No_Allotment

17

446466105

peter4

2011

2/18/19

12/23/2023

10/27/2023

9/22/2023

9/23/2023

6/2/2023

6/30/2023

7/1/2023

7/14/2023

1/13/2023

8/18/2023

18

565090917

peter5

2011

3/19/19

1/6/2023

1/20/2023

1/27/2023

2/3/2023

2/10/2023

2/17/2023

2/24/2023

3/3/2023

3/10/2023

3/17/2023

19

494170342

peter6

2011

4/16/19

4/18/2023

2/1/2023

10/8/2023

12/31/2023

7/24/2023

7/20/2023

12/3/2023

6/1/2023

6/2/2023

6/5/2023

20

9659517

peter7

2011

12/10/19

2/13/2023

3/10/2023

3/24/2023

4/7/2023

4/21/2023

5/5/2023

5/19/2023

6/16/2023

6/30/2023

7/10/2023

21

443968955

peter8

2011

12/10/19

11/24/2023

7/3/2023

3/29/2023

3/17/2023

4/26/2023

4/27/2023

9/5/2023

12/29/2023

7/21/2023

5/26/2023

22

277173473

peter9

2011

3/23/20

No_Selection

23

498138869

peter10

2011

7/20/20

1/3/2023

1/5/2023

12/31/2023

7/3/2023

7/6/2023

1/7/2023

9/10/2023

3/24/2023

2/6/2023

2/22/2023

24

53100

peter

2011

11/1/22

3/29/2023

4/26/2023

4/27/2023

9/5/2023

5/26/2023

4/21/2023

8/4/2023

6/23/2023

3/31/2023

4/7/2023

_proc

Cells with Data Validation
Cell	Allow	Criteria
A1	Any value

However, the results that I would like to have is below. The last entry for example should say New_Hire based on the Seniority date.

test_data.xlsm

A

B

C

D

E

F

G

H

I

J

K

L

M

N

O

P

Q

1

ID

Name

TOG

TOG_Name

ID_MU

Name_MU

Date_seniority

Day 1

Day 2

Day 3

Day 4

Day 5

Day 6

Day 7

Day 8

Day 9

Day 10

2

14417807

peter17

2011

4/24/06

7/30/2023

7/31/2023

8/1/2023

8/2/2023

8/3/2023

8/6/2023

8/7/2023

10/30/2023

10/31/2023

10/1/2023

3

253022876

peter18

2011

3/7/11

12/1/2023

12/2/2023

11/30/2023

12/29/2023

11/24/2023

11/25/2023

11/28/2023

1/3/2023

1/4/2023

10/21/2023

4

509647174

peter19

2011

7/7/14

3/26/2023

7/5/2023

7/6/2023

12/31/2023

12/28/2023

12/27/2023

12/26/2023

12/24/2023

3/27/2023

7/27/2023

5

112457891

peter20

2011

9/12/14

7/31/2023

8/1/2023

8/2/2023

8/3/2023

8/7/2023

10/30/2023

10/31/2023

12/24/2023

2/14/2023

2/15/2023

6

480168528

peter21

2011

11/16/15

6/24/2023

6/23/2023

7/15/2023

7/14/2023

2/14/2023

3/15/2023

1/28/2023

7/29/2023

7/13/2023

6/22/2023

7

24756624

peter22

2011

6/10/16

1/12/2023

5/14/2023

6/18/2023

12/24/2023

11/22/2023

12/26/2023

4/10/2023

3/19/2023

3/20/2023

3/21/2023

8

309738752

peter11

2011

7/22/16

2/15/2023

2/12/2023

5/22/2023

5/21/2023

5/7/2023

5/8/2023

10/29/2023

10/26/2023

11/26/2023

7/16/2023

9

690627818

peter12

2011

8/19/16

12/24/2023

7/2/2023

8/13/2023

7/9/2023

6/4/2023

6/11/2023

8/20/2023

7/23/2023

6/25/2023

8/27/2023

10

695256908

peter13

2011

8/26/16

5/4/2023

5/5/2023

11/21/2023

2/16/2023

10/28/2023

6/13/2023

6/14/2023

6/15/2023

6/16/2023

6/17/2023

11

912265825

peter14

2011

11/18/16

6/10/2023

9/27/2023

5/11/2023

7/17/2023

7/18/2023

7/19/2023

7/20/2023

7/21/2023

11/24/2023

11/25/2023

12

998320692

peter15

2011

3/26/18

1/14/2023

2/11/2023

2/25/2023

3/11/2023

3/25/2023

4/8/2023

4/22/2023

5/6/2023

5/20/2023

6/3/2023

13

245797967

peter16

2011

6/18/18

3/3/2023

3/4/2023

3/7/2023

12/26/2023

12/27/2023

11/24/2023

8/8/2023

9/2/2023

7/5/2023

10/6/2023

14

844973625

peter1

2011

11/5/18

2/19/2023

2/22/2023

2/23/2023

9/3/2023

9/6/2023

9/7/2023

1/4/2023

1/5/2023

7/10/2023

7/12/2023

15

233069302

peter2

2011

11/12/18

5/11/2023

3/12/2023

3/13/2023

12/26/2023

12/27/2023

12/28/2023

11/1/2023

11/2/2023

7/18/2023

7/19/2023

16

132674823

peter3

2011

2/18/19

11/16/2023

6/1/2023

6/5/2023

8/14/2023

5/28/2023

2/16/2023

4/10/2023

11/19/2023

No_Allotment

17

446466105

peter4

2011

2/18/19

12/23/2023

10/27/2023

9/22/2023

9/23/2023

6/2/2023

6/30/2023

7/1/2023

7/14/2023

1/13/2023

8/18/2023

18

565090917

peter5

2011

3/19/19

1/6/2023

1/20/2023

1/27/2023

2/3/2023

2/10/2023

2/17/2023

2/24/2023

3/3/2023

3/10/2023

3/17/2023

19

494170342

peter6

2011

4/16/19

4/18/2023

2/1/2023

10/8/2023

12/31/2023

7/24/2023

7/20/2023

12/3/2023

6/1/2023

6/2/2023

6/5/2023

20

9659517

peter7

2011

12/10/19

2/13/2023

3/10/2023

3/24/2023

4/7/2023

4/21/2023

5/5/2023

5/19/2023

6/16/2023

6/30/2023

7/10/2023

21

443968955

peter8

2011

12/10/19

11/24/2023

7/3/2023

3/29/2023

3/17/2023

4/26/2023

4/27/2023

9/5/2023

12/29/2023

7/21/2023

5/26/2023

22

277173473

peter9

2011

3/23/20

No_Selection

23

498138869

peter10

2011

7/20/20

1/3/2023

1/5/2023

12/31/2023

7/3/2023

7/6/2023

1/7/2023

9/10/2023

3/24/2023

2/6/2023

2/22/2023

24

53100

peter

2011

11/1/22

New_Hire

_proc

Cells with Data Validation
Cell	Allow	Criteria
A1	Any value

spittingfire · Nov 15, 2022

I found a solution, thanks

VBA Code:

'new
Sub uscc_file_run()
'Worksheets("_proc").Activate
NumRow_proc = Worksheets("_proc").Range("A2", Worksheets("_proc").Range("A2").End(xlDown)).Rows.Count + 1
NumRow_Voyageur_Result = Worksheets("_Voyageur_Result").Range("B2", Worksheets("_Voyageur_Result").Range("B2").End(xlDown)).Rows.Count + 1
NumRow_time_off = Worksheets("_time_off").Range("B2", Worksheets("_time_off").Range("B2").End(xlDown)).Rows.Count + 1
'Debug.Print "NumRow_proc : " & NumRow_proc
Dim cutOfdDate As Date
Dim srDate As Date
Dim Weekx As Variant
Dim Y As Integer
Dim Lookuparray As Range
Dim myindex As Range
Set Lookuparray = Worksheets("_Voyageur_Result").Range("B2:B" & NumRow_Voyageur_Result)
Set myindex = Worksheets("_Voyageur_Result").Range("F2:Y" & NumRow_Voyageur_Result)
Dim to_Lookuparray As Range
Dim to_myindex As Range
Set to_myindex = Worksheets("_time_off").Range("F2:L" & NumRow_time_off)
Set to_Lookuparray = Worksheets("_time_off").Range("A2:A" & NumRow_time_off)
Dim i As Integer
'NumRow_proc = Worksheets("_proc").Range("A2", Worksheets("_proc").Range("A2").End(xlDown)).Rows.Count + 1
'NumRow_Voyageur_Result = Worksheets("_Voyageur_Result").Range("B2", Worksheets("_Voyageur_Result").Range("B2").End(xlDown)).Rows.Count + 1
'NumRow_time_off = Worksheets("_time_off").Range("B2", Worksheets("_time_off").Range("B2").End(xlDown)).Rows.Count + 1
'Debug.Print "NumRow_proc : " & NumRow_proc
'Debug.Print "NumRow_Voyageur_Result : " & NumRow_Voyageur_Result
'Debug.Print "NumRow_time_off : " & NumRow_time_off




'For Y = 2 To NumRow_proc + 1
For Y = 2 To NumRow_proc
Debug.Print Worksheets("_proc").Cells(Y, 2) & "  -  " & i
Dim var As Range
Set var = Worksheets("_proc").Range("A" & Y)
srDate = Worksheets("_proc").Range("G" & Y)
cutOfDate = Worksheets("_time_off").Range("Q" & 2)

x = 1
i = 8
If srDate + 90 >= cutOfDate Then
    Worksheets("_proc").Cells(Y, i).Resize(1, 10) = "New_Hire"
       Else
repeat:
    If IsError(Application.Match(var, Lookuparray, 0)) Then
        Worksheets("_proc").Cells(Y, i).Resize(1, 10) = "No_Selection"
        i = 18
            Else
        If IsError(Application.Index(myindex, Application.Match(var, Lookuparray, 0), x)) Then
            Weekx = "No_Selection"
                Else:
            Weekx = Application.Index(myindex, Application.Match(var, Lookuparray, 0), x)
        End If
        Debug.Print "Weekx : " & Weekx
        
        
        If Weekx = "No_Selection" Then
            'Fill Function here
            Fill_us_No_Selection (Y)
                Else:
            Weekx_day = Application.Text(Weekx, "ddd")
            Debug.Print "Weekx_day : " & Weekx_day
            
            Select Case Weekx_day
                Case "Mon"
                    Weekx_day_col = 1
                Case "Tue"
                    Weekx_day_col = 2
                Case "Wed"
                    Weekx_day_col = 3
                Case "Thu"
                    Weekx_day_col = 4
                Case "Fri"
                    Weekx_day_col = 5
                Case "Sat"
                    Weekx_day_col = 6
                Case "Sun"
                    Weekx_day_col = 7
            End Select
            
            Debug.Print "Weekx_day_col : " & Weekx_day_col
            If IsEmpty(Application.Index(to_myindex, Application.Match(var, to_Lookuparray, 0), Weekx_day_col)) Then
                x = x + 1
                Debug.Print "X : " & x
                If x = 21 Then GoTo Endit
                GoTo repeat
                    Else:
                Allotx = Application.Index(Worksheets("_Voyageur_Allot").Range("A2:F372"), Application.Match(CLng(CDate(Weekx)), Worksheets("_Voyageur_Allot").Range("A2:A372"), 0), 5)
                Debug.Print "Allotx : " & Allotx
        
                If CLng(Allotx) >= 8 Then
                    var_row = Application.Match(CLng(CDate(Weekx)), Worksheets("_Voyageur_Allot").Range("A2:A372"), 0) + 1
                    Worksheets("_Voyageur_Allot").Range("E" & var_row).Value = Worksheets("_Voyageur_Allot").Range("E" & var_row).Value - 8
                    Worksheets("_proc").Cells(Y, i).Value = Weekx
                    x = x + 1
                    If x = 21 Then GoTo Endit
                    Debug.Print "X : " & x
                    i = i + 1
                    Debug.Print Worksheets("_proc").Cells(Y, 2) & "  -  " & i
                    If i = 18 Then GoTo Skipit
                    GoTo repeat
                        Else:
                    Worksheets("_proc").Cells(Y, i).Value = "No_Allotment"
                    x = x + 1
                    If x = 21 Then GoTo Endit
                    'i = i + 1
                    If i = 18 Then GoTo Skipit
                        
                    GoTo repeat
                End If
                If x = 21 Then GoTo Endit
            End If
        End If
    End If
Skipit:
Endit:
    Debug.Print i
    If i < 18 Then
        Worksheets("_proc").Cells(Y, i).Resize(1, 18 - i) = "No_Allotment"
    End If
End If
Next Y
End Sub


Function Fill_us_No_Selection(ByVal rowstart As Integer)
Dim j As Integer
For j = 8 To 17
Worksheets("_proc").Cells(rowstart, j).Value = "No_Selection"
Next j
End Function

Need help modifying an Excel VBA coded to add a check for new hires less that 90 days.

spittingfire

New Member

Excel Facts

spittingfire

New Member

Similar threads

Forum statistics

Share this page

Need help modifying an Excel VBA coded to add a check for new hires less that 90 days.

spittingfire

New Member

Excel Facts

spittingfire

New Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock