VBA Complicated Inquiry - Allocating staff to sessions

[Eng mona]

Hi Mr. HansV,

Thank you for your time attending to all inquiries here and in the Microsoft community.

I replied to you earlier in the Microsoft Community, but I find this website to be a more secure channel to share my inquiries and workbooks.

I have run the code that you have generously shared with me in the attached workbook, and it worked like a charm.

But I needed to do one more change which is increasing the station columns and respectively increasing the targets offsets. Assign names only to 2 columns and then offset them as per the criteria I have requested. I need the code to be adjusted to assign names to more than 2 columns and also offset all of them in the "model" columns by noting that names allocated in a day say Wednesday, should not be a model in another day "Thursday".

Many thanks in advance for all the help, time and support.

Kind rEgards,
Mona

[HansV]

Welcome to Eileen's Lounge!

Are the values currently in your workbook an example of what you want in the Station 1 ... Station 4 columns?

[Eng mona]

The values inthe sheet is the output after i used the below code:
they are somehow correct except of some conditions as below:
- C17 is offset to E18, which is on two different days. (Ideally, each staff should have a 20 min session in one day and then be a backup for the next 20:
if jame wu is in station 1 at 8:20, they should be model 1 at 8:40)

Used Code:
Sub FillRoster()
Dim src As Range
Dim trg As Range
Application.ScreenUpdating = False
' The first cell of the range of names
Set src = Worksheets("Sheet2").Range("A1")
' The first cell of the target range
Set trg = Worksheets("Sheet1").Range("B1")
trg.Offset(0, 2).Value = src.Offset(4).Value
trg.Offset(0, 3).Value = src.Offset(5).Value
' Loop through the list of names
Do
' Copy name
trg.Value = src.Value
trg.Offset(0, 1).Value = src.Offset(1).Value
trg.Offset(1).Value = src.Offset(2).Value
trg.Offset(1, 1).Value = src.Offset(3).Value
trg.Offset(1, 2).Resize(2, 2).Value = trg.Resize(2, 2).Value
Set src = src.Offset(4)
Set trg = trg.Offset(2)
Loop Until src.Value = ""
Application.ScreenUpdating = True
End Sub

[Eng mona]

oh sorry, I didn't answer all the questions. yes, I need 4 stations and 4 models for the output.

And I would want to know how to reduce/increase the number of stations/columns if required :)

Much a[appreciated, sir.

[HansV]

I'm not really sure what you want the result to be, in particular how you want the allocation to change at the start of a new day.
Please check the attached version, with a new macro and its result, and tell me how you want it to be different.
The number of Stations is now a constant in the code that can be changed.

Test - Workbook .xlsm

[Eng mona]

I am really sorry if I am confusing it or can't explain it more, but let me try more:
- the shared version is populating the desired output except for the names highlighted in the snapshot I am attaching.
- the code needs to be updated in a way that when the date is changed from Wednesday to Thursday, it allocates the name in the 8.40 session in station 1 , as model in 8.20 and so on. (e.g.: if you refer to the highlights in station 1 and model 1I don't want Samara to be assigned in 15.20 on Wednesday and then 8.20 Thursday, instead , Crystal Ool in 8.40 Thursday should be in 8.20 on Thursday as well)

[HansV]

I'll give it a try tomorrow.

[HansV]

Is this better?

Test - Workbook .xlsm

[Eng mona]

This is way better. Thank you so much, sir, for your great help.

One more thing but not urgent :)

Could you please help me create a user form in this sheet in a way that a question window pops up asking the user to insert the number of the required station? Rather than going and changing the station number inside the VBA code?

[HansV]

Try this version of the macro:

Code: Select all

Sub FillRoster()
    Dim NumberOfStations As Long
    Dim src As Range
    Dim trg As Range
    NumberOfStations = Application.InputBox(Prompt:="Enter the number of stations", Default:=4, Type:=1)
    If NumberOfStations < 2 Then
        MsgBox "The number pf stations must be at least 2!", vbExclamation
        Exit Sub
    End If
    Application.ScreenUpdating = False
    ' The first cell of the range of names
    Set src = Worksheets("Names2").Range("A2")
    ' The first cell of the target range
    Set trg = Worksheets("Trial2").Range("C2")
    ' Loop through the list of names
    Do
        If trg.Offset(0, -2).Value <> trg.Offset(-1, -2).Value Then
            trg.Offset(0, NumberOfStations).Resize(1, NumberOfStations).Value = _
                Application.Transpose(src.Offset(NumberOfStations, 0).Resize(NumberOfStations, 1).Value)
        End If
        trg.Resize(1, NumberOfStations).Value = Application.Transpose(src.Resize(NumberOfStations, 1).Value)
        trg.Offset(1, NumberOfStations).Resize(1, NumberOfStations).Value = trg.Resize(1, NumberOfStations).Value
        Set src = src.Offset(NumberOfStations)
        Set trg = trg.Offset(1)
    Loop Until src.Value = ""
    Application.ScreenUpdating = True
End Sub

[Eng mona]

Hat off to you sir. it is working like a charm.

I can't thank you enough for all the effort and time.

Could you please advise me on what I should do to improve my VBA skills? I need to start from the beginning till I reach an advanced level.

Is there some teaching/training material here in Eileen or some online that you can recommend? Many thanks in advance.

[HansV]

See for example VBA in Excel (in Simple Steps)

[Eng mona]

Mr. Han, I have one question,please.

The current code takes the second cell in station 1 and copies it to the first cell in model 1, and so on.

How can I adjust the code so I can copy the second cell ( or any cell I need in the future) instead of the first cell in station 1?


(example: instead of copying "James Wu" from (C3) to (G2) , I would want "Riley Wood" from (C4) to (G2)

[HansV]

I assume that you meant "so I can copy the third cell".

Code: Select all

Sub FillRoster()
    Dim NumberOfStations As Long
    Dim FirstRow As Long
    Dim src As Range
    Dim trg As Range
    NumberOfStations = Application.InputBox(Prompt:="Enter the number of stations", Default:=4, Type:=1)
    If NumberOfStations < 2 Then
        MsgBox "The number pf stations must be at least 2!", vbExclamation
        Exit Sub
    End If
    FirstRow = Application.InputBox(Prompt:="Get first model row from which station row?", Default:=2, Type:=1)
    If FirstRow < 2 Then
        MsgBox "Must be at least the second row!", vbExclamation
        Exit Sub
    End If
    Application.ScreenUpdating = False
    ' The first cell of the range of names
    Set src = Worksheets("Names2").Range("A2")
    ' The first cell of the target range
    Set trg = Worksheets("Trial2").Range("C2")
    ' Loop through the list of names
    Do
        If trg.Offset(0, -2).Value <> trg.Offset(-1, -2).Value Then
            trg.Offset(0, NumberOfStations).Resize(1, NumberOfStations).Value = _
                Application.Transpose(src.Offset(NumberOfStations * (FirstRow - 1), 0).Resize(NumberOfStations, 1).Value)
        End If
        trg.Resize(1, NumberOfStations).Value = Application.Transpose(src.Resize(NumberOfStations, 1).Value)
        trg.Offset(1, NumberOfStations).Resize(1, NumberOfStations).Value = trg.Resize(1, NumberOfStations).Value
        Set src = src.Offset(NumberOfStations)
        Set trg = trg.Offset(1)
    Loop Until src.Value = ""
    Application.ScreenUpdating = True
End Sub

[Eng mona]

Yes yes i meant third

and I have tested the one you shared and it worked perfectly. Many thanks sir.