eurometer2
eurometer2

Reputation: 21

Data validation list in Excel from 2-dimensional matrix/array

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:

skills matrix

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.

daily skills allocation

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.

daily skills overview

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:

Skills sheet

Then, there is an 'Availability' sheet with the availability of the employees (there are many part timers) that looks like this shape:

Availability sheet

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:

Plan sheet

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

Answers (4)

Evil Blue Monkey
Evil Blue Monkey

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:

  1. Your skill-employee list is located starting from cell A1 in a sheet called "Skill-employee list";
  2. Your AssignedSkillToday list is located starting from cell A1 in a sheet called "Today Assignments".

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

FaneDuru
FaneDuru

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:

  1. 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.

  2. The new added person name will be copied in the sheet "List" and an appropriate validation will be created

  3. 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:

  1. Copy the next code in a standard module:
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
  1. 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"

  2. 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).

  3. 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.

  4. 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

Variatus
Variatus

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

Dy.Lee
Dy.Lee

Reputation: 7567

You didn't give the sheet location and cell range. Therefore, the explanation is based on the example I made.

  1. Sheet event Code

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

Matrix Data Sheet (Sheets(2)) Image

enter image description here

Validation Sheet Image

enter image description here

Upvotes: 0

Related Questions