Reputation: 21
I am working on creating a daily planning for employees using a skills matrix. Each day, around 60 people must be scheduled for work. Each person is a assigned a skill for the day. The skills matrix is shaped as follows:
Then, for every day, depending on who are available, the idea is to allow the planner to select a skill appropriate for the person as to select the skill they are assigned for the day.
Ideally, they will be able to select the appropriate Skill for a person using a Data Validation drop down list that features solely the skill that the person in eligible for.
Then, we could create overviews as listed below, using counts for each of the skills.
Ideally, the data validation lists for selecting skills for each person specifically could be created dynamically changing based on the contents of the skills matrix. I've explored other posts and fora, but have yet to find a solution fit specifically for these 2-dimensional matrices. The closest I've found is from this post, but it uses a workaround where the OP mentioned they created a method in VBA to split out the 2d-matrix.
So, my question is if there is a means of doing this with solely Excel formulas (without VBA), or else if anyone knows a direction for creating this with VBA (I'm moderately proficient) so that additional employees and skills can be added dynamically to the original skills matrix.
EDIT:
@FaneDuru, I've found your code to work very well, thanks a lot! Please disregard my earlier comments on 'Required' employees, it was a number created arbitrarily. I have played with your VBA code a bit but I am unable to get it to work with an additional aspect I'm trying to add. Right now I have three sheets: the first is sheet 'Skills' and looks as follows, similar to what I've shared before:
Then, there is an 'Availability' sheet with the availability of the employees (there are many part timers) that looks like this shape:
The intention is that we update this weekly for the weeks dates with the availability of the employees. As is visible, some employees are never planned in this week, so ideally we won't show them in the 'Plan' sheet (similar to how you,FaneDuru, ideated the 'List' sheet). So the 'Plan' sheet ideally looks as follows:
Here, we have ideally allocated the Skills through the Data Validation in on the days that the personell are available (unavailable days I highlighted red), and then on the right we have an overview with counts per day. As you can see it is ideal that we dont show persons 'Hotel' and 'Gamma' on this Plan as they are unavailable this week. Right now I've created these sample sheets manually, as I cannot get the VBA code adjusted properly by myself.
However, I am having problems adjusting your VBA code so that they are not added to the sheet, and also creating the five columns for each day. Can you yield some pointers on how to realize this? Again thanks a lot, it means a bunch! I've been messing with VBA for several hours now but I'm a bit of a beginner to it.
Upvotes: 0
Views: 843
Reputation: 2629
Inspired by this explanation i've solved a similar problem in this question. I made an adaptation to your case. Since you've requested a solution with the least use of VBA as possible, my solution might still be interesting to you while others' solutions will be way easier to implement.
Since you didn't give many references, i'll assume that:
PHASE 1: create a new sheet.
Create a new sheet and name it "Calculations". We will put most of the stuff here. First of all we type "Selected row in Today Assignments" in the cell A1.
PHASE 2: determine which employee is selected.
Since we have multiple entry of employee in the AssignedSkillToday list, we will need multiple list of possible skills. Creating a dedicated list for each lane or costraining the user freedom would be unpractical. Therefore we need to know what row the user is selecting in the AssignedSkillToday list. We have to use VBA. Right-click on the "Today Assignments" sheet name tag and click on "View code". Copy-paste this code in the window that has appeared:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Filling the cell A2 in the sheet Calculation with the row number of the selected _
cell in the scheet Today Assignments.
Sheets("Calculations").Range("A2").Value = ActiveCell.Row
'Preventing multiple selection in the B column of the sheet Today Assignments.
If Not Application.Intersect(Target, Range("B:B")) Is Nothing Then
Target.Resize(1, 1).Select
End If
End Sub
This code will report in the cell A2 of the sheet Calculation the row number actually selected in the sheet "Today Assignments". Everytime the selection is changed, the value changes. It also prevent the selection of multiple rows of the B column in "Today Assignments" sheet (the column where skills dropdown list will be placed). You can test the code by changing the selection in the "Today Assignments" sheet and looking at the result in Calculations sheet.
In the Calculation sheet, type "Selected employee" in range B1. In range B2 type this formula:
=INDEX('TodayAssignments'!$A:$A,Calculations!$A$2,1)
This formula report the name of the employee selected.
PHASE 3: create the filtered list.
In sheet Calculations type "List stage 1" in cell C1. In cell C2 type this formula:
=IF(INDEX(INDIRECT("'Skill-employee list'!1:"&ROWS('Skill-employee list'!A:A)),MATCH(Calculations!$B$2,'Skill-employee list'!$A:$A,0),ROW()-ROW(Calculations!$C$2)+2)<>"",ROW()-ROW(Calculations!$C$2)+2,"")
Drag it all the way down until it will cover the same number of columns of the skill-employee list in the "Skill-employee list" sheet (or until a reasonable maximal amount of skills you will ever have in your list). This formula will "highlight" in what columns are the skills we are looking for (if there are any). At this point the list is very long, unsorted and presumably has a lot of blank cells. We need to sort it. In cell D1 type "List stage 2". In cell D2 type this formula:
=IF.ERROR(SMALL(E:E,ROW()-ROW(D$1)),"")
Drag this one down just like the previous one. Now we have a compact list of numbers. We need to translate them into skill's names. In cell E1 type "Filtered skill's list". In cell E2 type this formula:
=IF.ERROR(INDEX(INDIRECT("'Skill-employee list'!1:"&ROWS('Skill-employee list'!A:A)),1,Calculations!D2),"")
Drag it down again like previously did. We have our list.
PHASE 4: name the list.
We need to create a dynamic reference to the list to cut out all the blank cells. Define a new name calling it Skill_Filtered_List referred to this formula:
=INDIRECT("Calculations!$E$2:E"&MAX(2;ROWS(Calculations!$C:$C)-COUNTBLANK(INDIRECT("Calculations!$E$2:E"&ROWS(Calculations!$C:$C)))))
In the "Today Assignments" sheet, create a data validation for the skills column using the list mode and Skill_Filtered_List as origin.
This should do the trick. Like i've said: others' solution might be way easier to implement.
Report any question you have or bug you have encountered. If, according to your judgment, this answer (or any other) is the best solution to your problem you have the privilege to accept it (link).
Upvotes: 0
Reputation: 42236
You did not answer my clarification questions...
Please, check the next code solution. It uses array and should be very fast. It assumes that the matrix exists in a sheet named no matter how and the persons list exists in a sheet named "List". Please, copy the next code in the sheet module, where the matrix exists (right click on the sheet name and choose 'View Code'):
Option Explicit
Sub makeValidation(rngM As Range, lastR As Long, Target As Range, lastC As Long, Optional boolReset As Boolean)
Dim shL As Worksheet, lastRL As Long, i As Long, arrV, rngA As Range, arrHead
Set shL = Worksheets("List")
lastRL = shL.Range("A" & rows.count).End(xlUp).row
Set rngA = Range("A2:A" & lastR)
If lastRL <> lastR Then
If Target.Value <> "xxx" Then
'update the persons list
With shL.Range("A2:A" & lastR)
.ClearContents
.Value = rngA.Value
End With
Else
Target.ClearContents: Exit Sub
End If
End If
'adapt the validation
arrV = rngM.Value: arrHead = Range("B1", cells(1, lastC)).Value
If boolReset Then 'reset all persons range
For i = 2 To lastR
setValidation shL.Range("B" & i), arrV, i - 1, arrHead
Next i
Else
'reset anly the modified person skills
setValidation shL.Range("B" & Target.row), arrV, Target.row - 1, arrHead
End If
End Sub
Sub setValidation(rngV As Range, arrV As Variant, R As Long, arrHead As Variant)
Dim listValid As String, arrVal, i As Long
arrVal = Application.Index(arrV, R, 0) ' slice of row with skills definition
'find appropriate skills:
For i = 1 To UBound(arrVal)
If arrVal(i) = 1 Then listValid = listValid & arrHead(1, i) & ","
Next i
listValid = left(listValid, Len(listValid) - 1) 'eliminate last comma
With rngV.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
Operator:=xlBetween, Formula1:=listValid
.IgnoreBlank = True
.InCellDropdown = True
.ShowInput = True
.ShowError = True
End With
End Sub
It does the next things:
It is automatically triggered if any modification is in the range "B2" - Cells(last row, last column)
. I mean, it is dynamic. If a person will be added or a skill will be added, too, the code will run when values (1) will be added in the above described range.
The new added person name will be copied in the sheet "List" and an appropriate validation will be created
In case you need to test/adapt list validation, it can be done writing "xxx" in any cell of A:A column (in the sheet keeping the matrix).
Note: The code can be adapted to check if in the above described range something else then "1" will be input, to warn or transform it in "1". The code sets the skills based on this "1" position in the range. But, before that, please test the code and send some feedback.
Edited to put in place the last requirements:
Sub makePlan()
Dim shM As Worksheet, shAv As Worksheet, shPl As Worksheet, lastRM As Long
Dim lastRAv As Long, arrM, arrAv, arrPl, i As Long, sh As Worksheet, j As Long
Set shM = Worksheets("Matrix")
Set shAv = Worksheets("Availability")
For Each sh In Worksheets
'identify if sheet "Plan" exists:
If sh.Name = "Plan" Then Set shPl = sh: Exit For
Next
If shPl Is Nothing Then
'if sheets "Plan" does not exist, it is created:
Set shPl = Worksheets.Add(After:=shAv)
shPl.Name = "Plan"
End If
If shPl.UsedRange.count > 1 Then shPl.UsedRange.Clear ' clear its content if exists
lastRM = shM.Range("A" & rows.count).End(xlUp).row 'last row in Matrix sheet
arrM = shM.Range("A1:F" & lastRM).Value 'fill the matrix in array
lastRAv = shAv.Range("A" & rows.count).End(xlUp).row 'last row in Availability sheet
arrAv = shAv.Range("A1:F" & lastRAv).Value 'fill the sheet content in array
shPl.Range("A2").Resize(UBound(arrAv), UBound(arrAv, 2)).Value = arrAv 'drop the array content
shPl.Range("H2").Resize(UBound(arrAv), UBound(arrAv, 2)).Value = arrAv 'drop the array content
shPl.Columns("A:M").EntireColumn.AutoFit 'auto fit columns
arrPl = shPl.Range("A3:F" & lastRAv + 1).Value 'fill the validation area in array
'create validation
For i = 1 To UBound(arrPl)
If WorksheetFunction.count(shPl.Range("A" & i + 2 & ":F" & 2 + 1)) > 0 Then
For j = 1 To UBound(arrPl, 2)
If arrPl(i, j) = 1 Then makeValidation CStr(arrPl(i, 1)), shPl.cells(i + 2, j), arrM ': Exit For
Next j
End If
Next i
'create overview:____________________________________________________________
Dim arrSk, lastRPl As Long, strForm As String
arrSk = Application.Index(arrM, 1, 0) 'create a first row slice of the arrM array (skills)
shPl.Range("H2").Resize(UBound(arrSk), 1) = WorksheetFunction.Transpose(arrSk) 'copy skills
lastRPl = ActiveSheet.Range("A" & rows.count).End(xlUp).row 'last row in Plan sheet
strForm = "=IF(COUNTIF(B$3:B$" & lastRPl & ",$H3)>0,COUNTIF(B$3:B$" & _
lastRPl & ",$H3),"""")" 'formula string
shPl.Range("I3:M" & UBound(arrSk) + 1).ClearContents 'clear contents in the overview area
shPl.Range("I3").Formula = strForm 'copy the built formula
'autofill the formula. Firstly down and then to right:
shPl.Range("I3").AutoFill Destination:=Range("I3:I" & UBound(arrSk)), _
Type:=xlFillDefault
shPl.Range("I3:I" & UBound(arrSk)).AutoFill _
Destination:=shPl.Range("I3:M" & UBound(arrSk)), Type:=xlFillDefault
shPl.Range("A1").Value = "Plan of skills per day"
shPl.Range("H1").Value = "Overview of allocated imployees per day"
'______________________________________________________________________________
End Sub
Private Sub makeValidation(strPers As String, rngV As Range, arrM As Variant)
Dim listValid As String, arrVal, arrHead, i As Long, R As Long
For i = 1 To UBound(arrM)
If arrM(i, 1) = strPers Then R = i: Exit For 'determine the appropriate row
Next
arrVal = Application.Index(arrM, R, 0) ' slice of row with skills definition
arrHead = Application.Index(arrM, 1, 0) ' headers (skills, in fact)
'find appropriate skills:
For i = 1 To UBound(arrVal) ' eliminate spaces:
If arrVal(i) = 1 Then listValid = listValid & arrHead(i) & ","
Next i
listValid = left(listValid, Len(listValid) - 1) 'eliminate last comma
rngV.Value = Split(listValid, ",")(0) 'set the first element as value
With rngV.Validation 'create validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
Operator:=xlBetween, Formula1:=listValid
.IgnoreBlank = True
.InCellDropdown = True
.ShowInput = True
.ShowError = True
End With
End Sub
It check if a sheet named "Plan" exists. If it exists, the code clear it. If not, a new sheet is inserted and named "Plan"
A sheet named "Availability", looking like in your picture, must exist. It contents is used like basis for building everything in the plan worksheet. A sheet "Matrix" must also exist (or change Set shM = Worksheets("Matrix")
with your existing sheet keeping the skills matrix).
The code creates appropriate validations in cells marked with 1 (in "Availability" sheet) and select the first validation list option. Then bring all skills and places formulas able to create the overview.
For testing reason the code (Sub MakePlan()
should be run from VBE. It can be called from a button on the page, or from an event (Worksheet_Change
) in case of writing something (special) in a specific cell. After testing, I can help for the solution looking most suitable for you.
Please, check it and send some feedback,
Upvotes: 1
Reputation: 14383
Great minds think alike :-). My solution doesn't appear too much different from what @DyLe proposed. But different it is. So you can try them both.
My solution requires a table, just like the one you posted but set up as an Excel table (ListObject). The code refers to the table as being on "Sheet1" and you may have to change this location (1 place in the code). I called this table "SkillsMaster". If you want to call it "Table1" (or any other name) please change the name wherever you find "SkillsMaster" in the code. The table has the workers' names in column 1 and the skills' names in the header row from column 2, just like your sample. Cells are either blank or non-blank. The non-blank ones mark the skills, just as in your example.
The solution presumes that you have a list of names in column A on another sheet. This can be a copy from column 1 of the table or referenced by formulas or entirely independent. The sequence of names doesn't matter but the names must exist in the table.
The code requires you to specify a "TriggerRange". I specified B2:B6" but this could be anywhere and it could be changed to be dynamic, to match the number of names in your table (Sorry, I didn't think of this until now). Now, when you click any cell in the TriggerRange a validation will be created there with the appropriate validation list in it. This happens on the fly. Next time you click a new list will be shown.
In order for this to work, the code must be installed in the code sheet of the second tab. A standard code module won't receive the worksheet events. Therefore the code can't be activated as promised if it's in the wrong module.
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
' 105
Const TriggerRange As String = "B2:B6" ' location of validation dropdowns
Dim List() As String ' validation list
If Not Application.Intersect(Target, Range(TriggerRange)) Is Nothing Then
With Target
List = ValidationList(.Row)
With .Validation
.Delete
.Add Type:=xlValidateList, _
AlertStyle:=xlValidAlertStop, _
Formula1:=Join(List, ",")
.InputTitle = "Skills"
.ErrorTitle = "Skills"
.InputMessage = "Select a skill from the list"
.ErrorMessage = "Only the listed skills may be selected"
End With
.Value = List(1)
End With
End If
End Sub
Private Function ValidationList(ByVal Rw As Long) As String()
' 105
Dim Worker As String ' name retrievable from Sheet2!row Rw
Dim R As Long ' a row number in table "SkillsMaster"
' later loop counter: Arr columns
Dim Arr As Variant ' all values in row R
Dim Skills As Variant ' list of skills
Dim List() As String ' Validation list
Dim i As Integer ' index of List
Worker = Cells(Rw, "A").Value ' change the names column here
With Sheet1.Range("SkillsMaster")
' Columns(1) of the table holds the names
R = WorksheetFunction.Match(Worker, .Columns(1), 0)
Arr = .Rows(R).Value
Skills = .ListObject.Range.Rows(1).Value
End With
ReDim List(1 To UBound(Skills, 2))
For R = 2 To UBound(Arr, 2)
If Not IsEmpty(Arr(1, R)) Then
i = i + 1
List(i) = Skills(1, R)
End If
Next R
If i = 0 Then
i = 1
List(i) = "No skills"
End If
ReDim Preserve List(1 To i)
ValidationList = List
End Function
Extracting a count from the SkillsMaster table is the job for another day, and much simpler. You can probably do it easily enough with worksheet functions.
Upvotes: 0
Reputation: 7567
You didn't give the sheet location and cell range. Therefore, the explanation is based on the example I made.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Ws As Worksheet
Dim vDB
Dim Dic As Object 'Dictionary
Dim sList As String, s As String
Dim a() As Variant
Dim i As Integer, j As Integer, n As Integer
Set Dic = CreateObject("Scripting.Dictionary")
Set Ws = Sheets(2) '<~~ Sheet with matrix data
vDB = Ws.Range("a1").CurrentRegion '<~~ Matrix data
For i = 2 To UBound(vDB, 1)
n = 0
For j = 2 To UBound(vDB, 2)
If vDB(i, j) <> "" Then
n = n + 1
ReDim Preserve a(1 To n)
a(n) = vDB(1, j)
End If
Next j
Dic.Add vDB(i, 1), Join(a, ",")
Next i
If Target.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("b2:b6")) Is Nothing Then
With Target
.Validation.Delete
s = Target.Offset(, -1).Value
sList = Dic(s)
.Validation.Add xlValidateList, Formula1:=sList
End With
End If
End Sub
Upvotes: 0