Excel Macro Assistance Needed for Staff Roster and Training Allocation

I require your assistance in coding an Excel macro. Currently, I am working on a staff roster Excel sheet with two worksheets:

1. On the first worksheet (w1), staff details are listed.

2. On the second worksheet (w2), supervisor details are provided.

In w1, my first criteria involve filtering the A column. If the text cell in column A matches criteria, for example, “stall 3,” “stall 7,” “Stall 11,” I need to categorize these as “Area 1.” If the cell text is “stall 5,” “stall 14,” “stall 2,” they should be categorized as “Area 2.”

Additionally, in w1, starting from column E, there are various shift timing codes, such as XV=DAY, NB=DAY, VI=DAY, XP=NIGHT, DF=NIGHT, VJ=NIGHT, YY=OFF, LV=LEAVE, TR=TRAINING.

My second criteria involve filtering w1 based on these codes. For example, if E column’s 3rd cell contains “XV,” I want to categorize it as “DAY,” and if the 5th cell contains “XP,” I want to categorize it as “NIGHT.”

Now, I want to transfer these results to w2. In w2, shift supervisors’ names and their shift timings (only 2 shifts and 2 supervisors in each area) are provided. There are two supervisors on shift daily in each area. The first supervisor has the DAY shift (XV), and the second supervisor has the NIGHT shift (XP). Each supervisor is responsible for training two staff members on their shift in that particular area.

For example, if the 1st supervisor is “XV” on September 1st, they should train two staff members with the “DAY” shift code in that particular area on that day. To simplify this, I’ve repeated supervisor details twice in w2 in two rows.

My final criteria involve bringing the results from w1 to w2. We can place the results in w2’s F column and 2nd row. Based on the date and area in w2, I want to select random staff details (staff no, name and shift code) from w1 that match with the date and area.

To summarize the third criteria:

1. Match w1’s A column with w2’s E column (apply the second criteria here).

2. Match w1’s shift codes (from September 1st to September 30th) with w2’s A and D columns (apply the second criteria here).

3. Based on this third criteria, paste the relevant Staff No, Staff Name and Shift code into w2’s F column.

4. To ensure that two staff members are assigned to one supervisor, I’ve repeated the supervisor shift details twice in w2.

When bringing the staff no, staff name and shift to w2, I want to ensure uniqueness. Each area staff member should be trained only once. If all staff names are already filled for training once, we can repeat staff names to ensure the supervisor training column is not empty (only if it’s necessary), and I want to match with the date and area.

In essence, I’m seeking a result similar to the demo provided below.

I hope this clarifies my requirements. Please assist me in resolving this.

Thank you.

XLookup is available in Excel in Microsoft 365 and Office 2021. If you have an older version, you can use VLookup:

Sub FillRoster()
    Dim w1 As Worksheet
    Dim w2 As Worksheet
    Dim w3 As Worksheet
    Dim r1 As Long
    Dim m1 As Long
    Dim r2 As Long
    Dim m2 As Long
    Dim c1 As Long
    Dim n1 As Long
    Dim dt As Date
    Dim sc As String
    Dim ar As String
    Dim v1
    Application.ScreenUpdating = False
    Set w1 = Worksheets("w1")
    Set w2 = Worksheets("w2")
    Set w3 = Worksheets("Lists")
    m1 = w1.Cells(w1.Rows.Count, 1).End(xlUp).Row
    n1 = w1.Cells(1, w1.Columns.Count).End(xlToLeft).Column
    v1 = w1.UsedRange.Value
    For r1 = 3 To m1
        v1(r1, 1) = Application.VLookup(v1(r1, 1), w3.Range("A2:B15"), 2, False)
        For c1 = 5 To n1
            v1(r1, c1) = Application.VLookup(v1(r1, c1), w3.Range("D2:E10"), 2, False)
        Next c1
    Next r1
    m2 = w2.Cells(w2.Rows.Count, 1).End(xlUp).Row
    w2.Range(w2.Cells(2, 6), w2.Cells(m2, 8)).ClearContents
    For r2 = 2 To m2
        dt = w2.Cells(r2, 1).Value
        c1 = w1.Rows(1).Find(What:=dt, LookAt:=xlWhole).Column
        sc = Application.VLookup(w2.Cells(r2, 4).Value, w3.Range("D2:E10"), 2, False)
        ar = Trim(w2.Cells(r2, 5).Value)
        For r1 = 3 To m1
            If v1(r1, 1) = ar And v1(r1, c1) = sc Then
                w2.Cells(r2, 6).Value = v1(r1, 2)
                w2.Cells(r2, 7).Value = v1(r1, 3)
                w2.Cells(r2, 8).Value = w1.Cells(r1, c1).Value
                'v1(r1, 1) = ""
                v1(r1, c1) = ""
                Exit For
            End If
        Next r1
    Next r2
    Application.ScreenUpdating = True
End Sub

Forum Discussion

Excel Macro Assistance Needed for Staff Roster and Training Allocation

Share

Resources