Welcome to OGeek Q&A Community for programmer and developer-Open, Learning and Share
Welcome To Ask or Share your Answers For Others

Categories

0 votes
2.0k views
in Technique[技术] by (71.8m points)

find - vba - add multiple criteria: if entering word #1, #2 and so on in a cell, then messagebox

I'd like to add multiple criteria to this code:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
        Const srcCol As String = "A"
    Const Criteria As String = "*high*"
   
    Dim rng As Range: Set rng = Intersect(Columns(srcCol), Target)
    If rng Is Nothing Then
        Exit Sub
    End If
    
    Application.EnableEvents = False
    
    Dim aRng As Range
    Dim cel As Range
    Dim foundCriteria As Boolean
    For Each aRng In rng.Areas
        For Each cel In aRng.Cells
            If LCase(cel.Value) Like LCase(Criteria) Then
                MsgBox ("Please check 2020 assessment")
                foundCriteria = True
                Exit For
            End If
        Next cel
        If foundCriteria Then
            Exit For
        End If
    Next aRng
    
    Application.EnableEvents = True
           
End Sub

At the current state, this works in this way: if a cell of column "A" contains word "high", alert pop up. I would like to add more criteria: if cell in column "A" contains "high" but ALSO if a cell in column "A" contains "critic", show me the same alert box. I started from row "Const Criteria As String = "high", and tried adding "And", "Or", "If", "& _", but nothing seems working to add the second criteria. Any hint?

question from:https://stackoverflow.com/questions/65857382/vba-add-multiple-criteria-if-entering-word-1-2-and-so-on-in-a-cell-then-m

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome To Ask or Share your Answers For Others

1 Reply

0 votes
by (71.8m points)

A Worksheet Change: Target Contains One of Multiple Strings

  • If you plan on using exclusively contains for the various criteria, you can do the following changes:

    Const CriteriaList As String = "high,critic" ' add more
    
    If LCase(cel.Value) Like "*" & LCase(Criteria(n)) & "*" Then
    

The Code

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    
    Const srcCol As String = "A"
    Const Delimiter As String = "," ' change if you need "," in the criterias
    Const CriteriaList As String = "*high*,*critic*" ' add more
       
    Dim rng As Range: Set rng = Intersect(Columns(srcCol), Target)
    If rng Is Nothing Then
        Exit Sub
    End If
    
    Dim Criteria() As String: Criteria = Split(CriteriaList, Delimiter)
    
    Application.EnableEvents = False
    
    Dim aRng As Range
    Dim cel As Range
    Dim n As Long
    Dim foundCriteria As Boolean
    For Each aRng In rng.Areas
        For Each cel In aRng.Cells
            For n = 0 To UBound(Criteria)
                If LCase(cel.Value) Like LCase(Criteria(n)) Then
                    MsgBox ("Please check 2020 assessment")
                    foundCriteria = True
                    Exit For
                End If
            Next n
        Next cel
        If foundCriteria Then
            Exit For
        End If
    Next aRng
    
    Application.EnableEvents = True
           
End Sub

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
OGeek|极客中国-欢迎来到极客的世界,一个免费开放的程序员编程交流平台!开放,进步,分享!让技术改变生活,让极客改变未来! Welcome to OGeek Q&A Community for programmer and developer-Open, Learning and Share
Click Here to Ask a Question

...