Concatenated data in one cell; delete entire row when 1 piece of info is not present

Question

I run a report that displays a list of employees with all the information associated with their employment record. One of the things on there is a concatenated list of all their Employee Roles, with a Valid To and From date. For example, if the list of possible Roles is as follows:

• Role 1
• Role 1 – trainer
• Role 2
• Role 2 – trainer
• Role 3
• Role 3 – trainer
• Trainee employee
• Former employee
• Probationary employee

And there’s an employee who is checked off as Role 1, Role 1 – trainer, Role 2, and they used to be Role 3, the information will display in one cell as the following:

• Role 1 – 1/1/2020 to N/A;Role 1 – trainer – 1/1/2020;Role 2 – 1/1/2020 to N/A;Role 3 – 1/1/2020 to 28/2/2020

For the report I’m using, I only want to be able to see a list of Active employees in Role 1 (so, not including people who have retired from Role 1 but are still active in other Roles).

I have the following piece of code which allows me to remove from the list anyone does not have Role 1 in their record:

Sub deleteifnotR1 ()

    Dim ws As Worksheet
    Dim rng As Range
    Dim lastRow As Long

    Set ws = ActiveWorkbook.Sheets("Employee Record")

    lastRow = ws.Range("E" & ws.Rows.Count).End(xlUp).Row

    Set rng = ws.Range("E1:E" & lastRow)

    'filter and delete all but header row
    With rng
        .AutoFilter Field:=1, Criteria1:="<>*Role 1*"
        lr = Cells(Rows.Count, 1).End(xlUp).Row
        If lr > 1 Then
         Range("D2:D" & lr).SpecialCells(xlCellTypeVisible).EntireRow.Delete
        End If
    End With

    ' turn off the filters
    ws.AutoFilterMode = False

End Sub

The problem with this is that it will still leave me with a list of Former employees, and active employees who may have retired from Role 1, but are still Role 3 etc.

In thinking about how to fix this, I’ve had two ideas – firstly, is it possible to un-concatenate this data? For example, to insert new columns across the top with all the different possible roles, and then have a macro that identifies when someone has “Role 1 – trainer” in their record and move that data over to the correct column? Then I could use a variation of the code above to delete anyone who doesn’t have “N/A” in the Role 1 column.

Alternatively, is it possible to amend the following line:

.AutoFilter Field:=1, Criteria1:="<>*Role 1*"

To search in some way for “Role 1 – ANY DATE to N/A”? This would filter out both former employees, and employees who have retired from Role 1 but nothing else.

(Ideally I would just rework the report rather than having to fix it after the fact, but I don’t have access to that part of our system, and the people that do aren’t willing to do any development on it).

Thanks in advance for your help.

Answer 1

Unfortunately you can't use more inner-wildcards within AutoFilter. But maybe try to utilize Like operator or maybe more flexibile; regular expressions.

Try something like:

Sub deleteifnotR1()
Application.ScreenUpdating = False

    Dim ws As Worksheet
    Dim rng As Range
    Dim lastRow As Long, x As Long

    Set ws = ActiveWorkbook.Sheets("Employee Record")
    lastRow = ws.Range("E" & ws.Rows.Count).End(xlUp).Row

    With CreateObject("VBScript.RegExp")
        .Pattern = "\b[rR]ole 1 - \d{1,2}\/\d{1,2}\/\d{4} to N\/A\b"
        .Global = True
        For x = lastRow To 2 Step -1
            If Not .Test(ws.Cells(x, 5).Value) Then
                ws.Cells(x, 5).EntireRow.Delete
            End If
        Next x
    End With

Application.ScreenUpdating = True
End Sub

The pattern used is better visualized like:

As you can see it allows for both "role 1" and "Role 1" and does allow for dates written like "1/1/2020" or "10/10/2020".

If you got tons of data a better/faster approach would be to do this in memory through arrays. Hopefully this gets you started.

Note: You have currently used dash instead of a hyphen after "Role 1 ".