I'm looking for a way to use Excel VBA to check whether a cell on one sheet ("Sheet1") contains all of a cell from a list in a separate sheet ("Sheet2").

So, if A1 in "Sheet1" is "My favourite fruit is apples" And the list in "Sheet2" (A:A) is:

Pears

Bananas

Grapes

Apples

...

Then I would like cell B1 on "Sheet1" to say "Yes". This will need to loop through all cells with values in A:A on "Sheet1"

I've been trying this with WorksheetFunction.CountIf but can't get this to work as above.

Is anyone able to put me on the right path with this?

Many thanks!

CodePudding user response：

1. Concatenate used range of column A (Sheet2) - variable strcatSheet2A in the code.
2. Go through each cell (rng in code) in used range of column A (Sheet1)
3. Split the cell (rng) value, if it's not empty, into array of values.
4. Go through each value (val in code) and if it's not empty search if it's inside strcatSheet2A. If val is inside strcatSheet2A then just write "Yes" and exit the loop (the one that goes through values) and continue with the step 3.

Here is the simplified version of the code

Sub NotASub()
    Dim strcatSheet2A As String
    Dim val, rng
    strcatSheet2A = LCase(Join(WorksheetFunction.Transpose(Intersect([Sheet2].Range("A:A"), _
                                             [Sheet2].UsedRange).Value2), vbNullString))

    For Each rng In Intersect([Sheet1].Range("A:A"), [Sheet1].UsedRange)
        If rng.Value <> Empty Then
            For Each val In Split(rng.Value, " ")
                If Len(val) > 0 Then
                    If InStr(1, strcatSheet2A, LCase(Trim(val))) > 0 Then
                        rng.Offset(0, 1).Value = "Yes"
                        Exit For
                    End If
                End If
            Next val
        End If
    Next rng
End Sub

Further explanation:

1. Intersect has self explanatory functionality, here it just makes the code run faster.
2. Transpose is needed because a column is 2D array, and we need 1D to make use of JOIN

Following up on your question from the comment

Sub NotASub2()
    Dim A1 As Variant, A2 As Variant
    A1 = WorksheetFunction.Transpose(Intersect([Sheet1].Range("A:A"), _
                             [Sheet1].UsedRange).Value2)
    A2 = WorksheetFunction.Transpose(Intersect([Sheet2].Range("A:A"), _
                             [Sheet2].UsedRange).Value2)

    Dim i As Long, j As Long
    For i = LBound(A1) To UBound(A1)
        For j = LBound(A2) To UBound(A2)
            If Len(A2(j)) > 0 And InStr(1, LCase(A1(i)), LCase(A2(j))) > 0 Then
                [Sheet1].Cells(i, 2).Value = "Yes"
                Exit For
            End If
        Next j
    Next i
End Sub