6 admins, 100 staff

[Jimmasterton]

Hi experts, I m back with another vague and cryptic problem, and I ll be honest and say this probably isnt even do able.

Imagine an office with 106 staff , 6 admins responsible for organising the appointments of 100 staff. A random schedule needs to be designed on a weekly basis (daily if there’s one of the 6 admins on leave or sick)

I have created a worksheet with the 6 admins names down the left hand side (A10, A15, A20 so on) next to each admin name I need an on off device to take into account if they should be included in the split of work
Each admin has a color assigned to them .

On the right hand side of the sheet a ten by ten table with the hundred staff names

What I would like to do is hit a button and have the 100 name table covered with a random but fairly even split of work, taking into account the admins that are off.

Is this even possible?!?

 

[Eric W]

Do you just want the available admins to be randomly assigned to the 10X10 table? Is the staff already in it? Do you want the admins to overwrite the staff name, or maybe have another 10X10 table next to it?

As far as an on/off device, it could be as simple as an X in a cell, or we could add a checkbox, whatever you'd prefer.

 

[Jimmasterton]

Hi Eric
Thanks for such a fast response, basically Id just like a grid 10x19 to be coloured randomly but fairly so I can edit the names of the hundred whenever I need to, so there’s no names in it yet just a grid. The 6 colors would correspond to the 6 names of the admins, so I could basically color the cells of the admin names
As for an on off switch, I could make a button that toggles red and green?

 

[Eric W]

OK, here's some steps to follow to get your workbook working the way you want.

First, open a new workbook with nothing in it. Right click on the sheet tab on the bottom and select View Code. Paste the following code in the window that opens:

Sub MyColors()

    For i = 1 To 56
        Cells(i, "A").Interior.ColorIndex = i
        Cells(i, "A") = i
    Next i
    
End Sub

Put the cursor on the top line and press F5. Now if you go back to Excel, you'll see the 56 default colors Excel has. Choose the six you want and write down the numbers. Excel has millions to choose from, but odds are you can find 6 good choices here, and it's just easier this way.

Next, make a copy of your workbook. Open the copy. Your admins are in A10, A15, etc. I assume B10, B15, etc. are all available to be used. Select all of those cells (as a group is easier, but one at a time if you want). Select a GREEN fill color. Now with all of the cells still selected, from the HOME tab of the ribbon, click the drop-down box in the Number section and select More Number Formats > Custom > and in the Type: box, put ;;; (3 semicolons). Finally, with all 6 cells still selected, click Conditional Formatting > New Rule > Use a Formula > and enter:
=B10=TRUE
and select a RED fill color.

Now we're going to put in a checkbox to say if the admin is absent or not. If you don't have the Developer tab on your ribbon, click File > Options > Customize Ribbon > and on the right side, select the Developer box and click OK. Now from the Developer tab, click Insert > and pick the checkbox (1st row, 3rd from left). Now use the mouse to draw a rectangle over B10. It will create a checkbox. To edit it, right click on it. If you click inside it, you can edit the text to say Absent instead of Check Box 1. Right click on it, select Format Control > Control tab > and enter B10 in the Cell link: box. Now when you check the box, you should see it change color. Repeat for the other B cells. You can copy the first one, and paste it 5 times if you want, but you'll have to change the Cell link: for each one.

Right click on the sheet tab, select View Code. From the menu click > Insert > Module. Paste this code:

Sub Assign()
Dim ad As Long, Admins() As Variant, r As Long, x As Long, sw1 As String, sw2 As Long
Dim MyColors As Variant, MyKeys(1 To 100) As Long, c1 As Range, MyTab As Range

    Set MyTab = Range("H11")
    MyColors = Array(3, 4, 5, 6, 7, 8)

    ad = 0
    For r = 10 To 35 Step 5
        If Cells(r, "B") = False Then ad = ad + 1
    Next r
    ReDim Admins(1 To ad, 1 To 2)

    ad = 0
    For r = 10 To 35 Step 5
        Cells(r, "A").Interior.ColorIndex = MyColors(r / 5 - 2)
        If Cells(r, "B") = False Then
            ad = ad + 1
            Admins(ad, 1) = Cells(r, "A")
            Admins(ad, 2) = MyColors(r / 5 - 2)
        End If
    Next r
   
    Randomize

    For r = 1 To ad
        x = Int(Rnd() * ad) + 1
        sw1 = Admins(r, 1)
        sw2 = Admins(r, 2)
        Admins(r, 1) = Admins(x, 1)
        Admins(r, 2) = Admins(x, 2)
        Admins(x, 1) = sw1
        Admins(x, 2) = sw2
    Next r
  
    For r = 1 To 100
        MyKeys(r) = r - 1
    Next r
 
    MyTab.Resize(10, 10).Interior.ColorIndex = 0
    c = 1
    For r = 1 To 100
       x = Int(Rnd() * (101 - r)) + 1
        Set c1 = MyTab.Offset(MyKeys(x) \ 10, MyKeys(x) Mod 10)
        If c1.Value <> "" Then
            c1.Interior.ColorIndex = Admins(c, 2)
            c = IIf(c = ad, 1, c + 1)
        End If
        MyKeys(x) = MyKeys(101 - r)
    Next r
          
End Sub

Go to the lines in red. Change the top one so that it points to the upper left corner of your 10X10 table. In the next one, put the 6 numbers corresponding to the colors you picked.

Finally, go back to your Excel sheet. From the Developer tab, click Insert > and select a button (top left). Use the mouse to put it on the sheet where you want. It will ask what macro you want, select Assign and click OK. Now right click on the button, and choose Edit Text to pick your desired button name.

That's it. Click on the button to get it to work. It will randomly color every cell in your 10X10 table that has something in it. Each color will be used the same number of times +/- 1, based on the remainders.

Let me know how it works for you.

 

[Jimmasterton]

This is incredible Eric! Thank you very much! I’ll try it on Monday and get back to you

 

[Jimmasterton]

Eric, I can’t thank you enough, I honestly have no concept of the capability of excel and an expert with vba. I would like to just add to this bit of code by summarising the work on sheet 2.

So, Tom one of the admins has a blue colour and every blue random cell in the 100 range I would like the cell value to copy to sheet 2 under the name Tom

But I’d like to try and write this myself, Im trying to learn

Can I just ask, what is your background with VBA? The module you wrote seems extremely complex. Is it?

Thanks again!

 

[Eric W]

I'm glad it works for you! I've worked with Excel for over 20 years, and I'm still learning about some of the incredible things it can do. I wouldn't say that macro is particularly complex. Probably 30-40 minutes to write and test. (Writing the instructions took longer! ) But each of the pieces in it I've written hundreds of times in my career, so it was just a matter of putting them together. I should have added a few comments to explain the various parts though, just good programming practice. But even without the comments, there's probably 10 or more people on this board who could figure it out, or even write a better version. There are a couple of "tricks" I used in the last paragraph, everything else is pretty straightforward. VBA isn't my main language, so I'm still learning some techniques.

Writing the summary on sheet2 would only take a few changes to this macro. Since you want to take a shot at it, I won't write it up. If you have any questions, let me know. If you want the commented version of that macro, let me know.

Good luck!

 

[Jimmasterton]

I can’t do it!

I’ve got the basics, and I am pretty sure that it should tie in with the previous macro, but I just don’t have the knowledge to summarise the 6 admins work on sheet 3 according to colour

If range(“D10”).Interior.ColorIndex =3 Then
Sheets(“Sheet3”).Range(“A3”) = Range(“D10”).Value
End if

Exasperating
If anyone can help me, or if you are still out there Eric can you explain your solution for me?

 

[Eric W]

Give this a shot:

Sub Assign()
Dim ad As Long, Admins() As Variant, r As Long, x As Long, sw1 As String, sw2 As Long
Dim MyColors As Variant, MyKeys(1 To 100) As Long, c1 As Range, MyTab As Range, SumTab As Worksheet

' Define the parameters
    Set MyTab = Range("H11")
    MyColors = Array(3, 4, 5, 6, 7, 8)
    Set SumTab = Worksheets("Sheet3")

' Find out how many admins we have, look at A10,A15,A20,A25,A30,A35 and count the FALSEs
    ad = 0
    For r = 10 To 35 Step 5
        If Cells(r, "B") = False Then ad = ad + 1
    Next r
    ReDim Admins(1 To ad, 1 To 2)           ' Define the size of the Admins array
    
' Fill the Admins array with the names of the admins, and their colors
    ad = 0
    For r = 10 To 35 Step 5
        Cells(r, "A").Interior.ColorIndex = MyColors(r / 5 - 2)
        If Cells(r, "B") = False Then
            ad = ad + 1
            Admins(ad, 1) = Cells(r, "A")
            Admins(ad, 2) = MyColors(r / 5 - 2)
        End If
    Next r
   
    Randomize
    
' Now randomly sort the admins, so that if the number of assignments isn't even, then
' the extra assignments don't always go to the same admin.
' We sort by going through the whole list, and switching each name with a random name.
    For r = 1 To ad
        x = Int(Rnd() * ad) + 1
        sw1 = Admins(r, 1)
        sw2 = Admins(r, 2)
        Admins(r, 1) = Admins(x, 1)
        Admins(r, 2) = Admins(x, 2)
        Admins(x, 1) = sw1
        Admins(x, 2) = sw2
    Next r
  
' Set up an array from 0 to 99, representing each cell in the table.  If you divide a
' number from 0 to 99 by 10, the quotient is the row, and the remainder is the column.
    For r = 1 To 100
        MyKeys(r) = r - 1
    Next r
 
' Clear the colors from the table
    MyTab.Resize(10, 10).Interior.ColorIndex = 0
    
' Clear the summary sheet, then put the admin names in the top row
    SumTab.Cells.ClearContents
    SumTab.Cells.Interior.ColorIndex = 0
    For i = 1 To ad
        SumTab.Cells(1, i) = Admins(i, 1)
        SumTab.Cells(1, i).Interior.ColorIndex = Admins(i, 2)
    Next i
    
' Go through the list.  We randomly pick a number from the list and assign it to the
' next admin.  Then we remove that number from the list by replacing it with the last
' number left on the list.  c represents the number of the next admin to use.
    c = 1
    For r = 1 To 100
       x = Int(Rnd() * (101 - r)) + 1
        Set c1 = MyTab.Offset(MyKeys(x) \ 10, MyKeys(x) Mod 10)
        If c1.Value <> "" Then
            c1.Interior.ColorIndex = Admins(c, 2)           ' set the color
            SumTab.Cells(Rows.Count, c).End(xlUp).Offset(1).Value = c1.Value ' save the name on the summary tab
            c = IIf(c = ad, 1, c + 1)
        End If
        MyKeys(x) = MyKeys(101 - r)
    Next r
          
End Sub

Let me know how it works.

 

[Jimmasterton]

Incredible, Eric thanks again. This is the only reason I go to work early now to try your work! I also type it in as a discipline! I’ll come back to you, trying it tomorrow.