Question

Please click on this link for the image of the excel sheet containing the data:

https://i.stack.imgur.com/Dl1YQ.gif

I have a list of task codes in column A.

During each task I will gain a certain competencies. Each competency listed in column C or E is gained during the tasks listed in columns D and F respectively.

Now I need a formula to tell me on column B (COMPETENCIES), which of the competencies are gained during each task of column A. For example for Task A2 (MSC) I expect to see “Tech1,Tech2,Tech3,Tech4,PS1,PS2,PS3” in column B (B2).

I suppose I should treat task codes in column A as strings that should be looked for in the cell contents of columns D and F and when found in any cell of those columns, the corresponding competency should be copied from the same row on the column to the left of the cell, into column B. And then all these entries should be separated by commas in each cell of column B (if there is more than one competency met during task A2).

Can you help me please?

Many Thanks,

Hamid

Answer 1

I agree with the comments: this is a task for VBA.

I typed your GIF into a worksheet. I have made no attempt to fix what I believe are errors. For example, Column A contains “SEMS” but column D contains “SMES”.

Step 1 of the routine below is to work down columns C and D then columns E and F and accumulates the data in an array of structures. The objective is to reverse the relationships to give:

MSC  Tech1 Tech2 ...
ATT  Tech1 Tech2 ...
 :     :  

The result is them placed in column B.

The first step is quite complicated. I hope I have included enough comments for you to understand my code. Work through it slowly and come back with questions is necessary.

Option Explicit

' VBA as intrinsic data types : string, long, double, etc.
' You can declare an array of longs, say.
' The size of an array can be fixed when it is declared:
'      Dim A(1 To 5) As Long
' or it can be declared as dynamic and then resized as necessary:
'      Dim A() As Long
'      ReDim A(1 to 5)           ' Initialise A with five entries
'      ReDim Preserve A(1 to 10) ' Preserve the first five entries in A
'                                ' and add another 5.
'
' Sometimes a more complex structure is required. For this problem we need
' to build a list of Tasks with a list of Competencies against each Task.
' VBA allows us to to define the necessary structure as a "User Type"

' Define a user type consisting of a Task name and an array of Competencies
Type typTaskComp
  Task As String
  Comp() As String
End Type

' Declare array in which Tasks and Competencies are
' accumulated as a dynamic array of type typTaskComp.
Dim TaskComp() As typTaskComp
Dim InxTaskCrntMax As Long
Sub MatchTaskToCompetencies()

  Dim CompListCrnt As String
  Dim InxCompCrnt As Long   ' Index for Competencies for a Task
  Dim InxTaskCrnt As Long   ' Index for Tasks
  Dim RowCrnt As Long
  Dim TaskCrnt As String

  ReDim TaskComp(1 To 10)     ' Initialise TaskComp for 10 Tasks
  InxTaskCrntMax = 0        ' The last currently used row in TaskComp. That
                              ' is, no rows are currently used.

  ' Load array TaskComp() from the sheet
  Call DecodeCompencyTask("Sheet1", 3, 4)
  Call DecodeCompencyTask("Sheet1", 5, 6)
  ' The format and contents of TaskComp is now:
  '         Competency ...
  '   Task  1     2     3     4     5 ...
  ' 1 MSC   Tech1 Tech2 Tech3 Tech4 PS1
  ' 2 ATT   Tech1 Tech2 Tech3 Tech4 PS1
  ' 3 PLCY  Tech1 Tech2 Tech4 Tech5 Tech6
  ' :   :

  ' Display contents of TaskComp() to Immediate window
  For InxTaskCrnt = 1 To InxTaskCrntMax
    Debug.Print Left(TaskComp(InxTaskCrnt).Task & Space(5), 6);
    For InxCompCrnt = 1 To UBound(TaskComp(InxTaskCrnt).Comp)
      If TaskComp(InxTaskCrnt).Comp(InxCompCrnt) = "" Then
        Exit For
      End If
      Debug.Print Left(TaskComp(InxTaskCrnt).Comp(InxCompCrnt) & Space(5), 6);
    Next
    Debug.Print
  Next

  ' Now place lists of Competencies in Column 2 against appropriate Task
  RowCrnt = 2
  With Worksheets("Sheet1")
    TaskCrnt = .Cells(RowCrnt, 1).Value
    Do While TaskCrnt <> ""
      For InxTaskCrnt = 1 To InxTaskCrntMax
        If TaskCrnt = TaskComp(InxTaskCrnt).Task Then
          ' Have found row in TaskComp that matches this row in worksheet
          ' Merge list of Competencies into a list separated by commas
          CompListCrnt = Join(TaskComp(InxTaskCrnt).Comp, ",")
          ' Empty entries at the end of TaskComp(InxTaskCrnt).Comp will
          ' result in trailing commas.  Remove them.
          Do While Right(CompListCrnt, 1) = ","
            CompListCrnt = Mid(CompListCrnt, 1, Len(CompListCrnt) - 1)
          Loop
          ' and place in column 2
          .Cells(RowCrnt, 2).Value = CompListCrnt
          Exit For
        End If
      Next
      RowCrnt = RowCrnt + 1
      TaskCrnt = .Cells(RowCrnt, 1).Value
    Loop
  End With

End Sub
Sub DecodeCompencyTask(WShtName As String, ColComp As Long, ColTask As Long)

  ' Sheet WShtName contains two columns numbered ColComp and ColTask,  Column
  ' ColComp contains one Competency per cell.  Column ColTask holds a comma
  ' separated list of Tasks per cell.  For each row, the Competency is gained
  ' by performing any of the Tasks.

  ' Scan the two columns.  If a Task is missing from TaskComp() prepare a row
  ' for it.  Add the Competency to the new or existing row for the Task.

  Dim CompCrnt As String
  Dim Found As Boolean
  Dim InxCompCrnt As Long   ' Index for Competencies for a Task
  Dim InxTaskCrnt As Long   ' Index for Tasks
  Dim RowCrnt As Long
  Dim TaskCrnt As Variant
  Dim TaskList() As String

  With Worksheets(WShtName)
    RowCrnt = 2
    Do While .Cells(RowCrnt, ColComp).Value <> ""
      CompCrnt = .Cells(RowCrnt, ColComp).Value  ' Extract Competency
      ' Remove any spaces from Task List and then split it
      ' so there is one Task per entry in TaskList.
      TaskList = Split(Replace(.Cells(RowCrnt, ColTask).Value, " ", ""), ",")
      ' Process each task in TaskList
      For Each TaskCrnt In TaskList
        Found = False
        ' Look for current Task in existing rows
        For InxTaskCrnt = 1 To InxTaskCrntMax
          If TaskComp(InxTaskCrnt).Task = TaskCrnt Then
            Found = True
            Exit For
          End If
        Next
        If Not Found Then
          ' New Task found.  Prepare new row with Task but no
          ' Competencies
          InxTaskCrntMax = InxTaskCrntMax + 1
          If InxTaskCrntMax > UBound(TaskComp) Then
            ' No free rows in TaskComp.  Add some more rows
            ReDim Preserve TaskComp(1 To UBound(TaskComp) + 10)
          End If
          InxTaskCrnt = InxTaskCrntMax
          TaskComp(InxTaskCrnt).Task = TaskCrnt
          ReDim TaskComp(InxTaskCrnt).Comp(1 To 5)
          ' Rely on array entries being initialised to ""
        End If
        Found = False
        ' Look for an empty Competency slot in current row of TaskComp
        For InxCompCrnt = 1 To UBound(TaskComp(InxTaskCrnt).Comp)
          If TaskComp(InxTaskCrnt).Comp(InxCompCrnt) = "" Then
            Found = True
            Exit For
          End If
        Next
        If Not Found Then
          ' Row is full. Add some extra entries and set InxCompCrnt to
          ' first of these new entries.
          InxCompCrnt = 1 + UBound(TaskComp(InxTaskCrnt).Comp)
          ReDim Preserve TaskComp(InxTaskCrnt).Comp(1 _
                                   To UBound(TaskComp(InxCompCrnt).Comp) + 5)
        End If
        TaskComp(InxTaskCrnt).Comp(InxCompCrnt) = CompCrnt
        InxCompCrnt = InxCompCrnt + 1
      Next
      RowCrnt = RowCrnt + 1
    Loop
  End With

End Sub