0

How to create data validation based on multiple roles?

We have multiple roles in column L, like Admin, Clerk, Moderator, and User.

I would like to check if these roles are spelled correctly and if not it should highlight the cell red.

Is this possible?

1 Answers1

0

Data Validation Via Worksheet Change

  • To 'update' the colors, do a 'Copy/PasteValues' in column L.

Sheet Module (e.g. Sheet1)

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    
    Const RolesList As String = "Admin,Clerk,Moderator,User"
    Const FirstCellAddress As String = "L2"
    Const Delimiter As String = "||"
    
    Dim rng As Range
    With Range(FirstCellAddress)
        Set rng = Intersect(.Resize(.Worksheet.Rows.Count - .Row + 1), Target)
    End With
    If rng Is Nothing Then
        Exit Sub
    End If
    
    Dim Roles() As String: Roles = Split(RolesList, ",")
    
    Dim dRng As Range
    Dim aRng As Range
    Dim cel As Range
    Dim Curr() As String
    Dim cMatch As Variant
    Dim n As Long
    Dim isFound As Boolean
    
    For Each aRng In rng.Areas
        For Each cel In aRng.Cells
            If Not IsError(cel) Then
                Curr = Split(cel.Value, Delimiter)
                For n = 0 To UBound(Curr)
                    cMatch = Application.Match(Curr(n), Roles, 0)
                    If IsError(cMatch) Then
                        isFound = True
                        Exit For
                    Else
                        ' Remove this block if you don't need case-sensitivity.
                        If StrComp(Curr(n), Roles(cMatch - 1), _
                                vbBinaryCompare) <> 0 Then
                            isFound = True
                            Exit For
                        End If
                    End If
                Next n
                If isFound Then
                    isFound = False
                    If dRng Is Nothing Then
                        Set dRng = cel
                    Else
                        Set dRng = Union(dRng, cel)
                    End If
                End If
            End If
        Next cel
    Next aRng
    
    Application.ScreenUpdating = False
    rng.Interior.Color = xlNone
    If Not dRng Is Nothing Then
        dRng.Interior.Color = vbRed
    End If
    Application.ScreenUpdating = True
    
End Sub
VBasic2008
  • 44,888
  • 5
  • 17
  • 28