Search Array of strings for an exact match of string containing more than one word (case insensitive)

[sctlippert2]

This code works, but only if it is one word... how do I change it to look for an exact phrase?

InStr(1, ArrayContainingStrings(i, 1), WORD, vbTextCompare) <> 0

 

[sctlippert2]

If you post data that can be used (with instructions if it's not obvious to anyone else) it would make it easier to help with your code as we cannot see what's going into the array. But not pictures of data.

This
Instr(1,"mary had a little lamb","MARY HAD A LITTLE LAMB",vbTextCompare)
returns 1. This
Instr(1,"I heard that mary had a little lamb","MARY HAD A LITTLE LAMB",vbTextCompare)
returns 14 so it should prove that multiple words that comprise a string can be found within a string. That seems to deal with your initial post. The problem is likely within your array. Note that vbTextCompare is equivalent to 1, which you are using.

Some observations on the code:
Comments within code could help others to better understan what is happening.

I personally would not use an error handler to deal with a sheet that already exists as opposed to just dealing with it in the IF block. That's because it's not an error, but that's me. The exception would be if I was making that scenario into a custom error number that gets ADDED to the error evaluations. However, you're not doing multiple evaluations, or even providing for any other error that may arise (1004 is the one that seems most prevelant in Excel vba). Instead perhaps the msgbox should provide OK/Cancel options. OK reopens the input box, cancel exits sub. That way you don't reinitialize your variables. That's more important when they are objects and have been Set, which you're not doing. Point is, it's not the best habit to get into.

You don't need to activate or select sheets, ranges and such to get at their properties - it slows down code.

Using used range to get last row will include formatted but empty cells. Using Find is considered better.

Not sure about the comments remark, I thought that I had enough comments except where the main loop was, you thought I needed more? Also, I guess I could have just have moved the errorhandler code up within that loop and exited the sub... that would clean that up. The input has to run through the sheets and then creates it if it doesn't exist. I suppose I could search in the main loop and if it finds data, THEN create the sheet, that would clean up the program even more. I still don't know why the array is not working. I thought that it would have worked with more than one word, but the search comes up empty. Thank you for the helpful comments on cleaning up the code.

 

[igold]

Your code as written works for me. The only changes other than what @Micron suggested would be to not go to and from and the sheet in the middle of your loop. I would also use "Option Explicit"
The altered portion of code below uses most of what you did with a few changes. The code does find the string in the array using my fictitious data...

Sub InputTopic()

    Dim LastRow As Long, LastCol As Long, LastColLetter As String
    Dim VerseArray() As Variant, i As Long, x As Long, k As Long
    Dim SourceWS As Worksheet, Topic As String, ws As Worksheet
    Dim arr2

    Topic = InputBox("Enter Topic or Word to search for...")
 
    'Check If Sheet Already Exists
    For Each ws In ThisWorkbook.Worksheets
        If InStr(1, ws.Name, Topic, vbTextCompare) <> 0 Then GoTo errorhandler:
    Next ws

    Sheets.Add(After:=Sheets(Sheets.Count)).Name = Topic
    Columns("A:A").ColumnWidth = 100                    'Columns.AutoFit
    Columns("A:A").WrapText = True
    Columns("B:B").ColumnWidth = 10

    Set SourceWS = Sheets("PROVERBS")
    SourceWS.Activate
    LastRow = ActiveSheet.UsedRange.SpecialCells(xlCellTypeVisible).Rows.Count     'FIND # of LAST Row w/ DATA
    LastCol = ActiveSheet.UsedRange.SpecialCells(xlCellTypeVisible).Columns.Count  'FIND # of LAST Column w/ DATA
    LastColLetter = Split(Cells(1, LastCol).Address, "$")(1)         'CHANGE # to Actual LETTER of COLUMN
    ReDim arr2(1 To LastRow, 1 To LastCol)
    VerseArray = Range("A1:" & LastColLetter & LastRow)   'inputs data automatically into array
    x = 0
    For i = LBound(VerseArray, 1) To UBound(VerseArray, 1)
        If InStr(1, VerseArray(i, 1), Topic, vbTextCompare) <> 0 Then
                x = x + 1: Sheets(Topic).Select
            arr2(x, 1) = VerseArray(i, 1)
            arr2(x, 2) = VerseArray(i, 2)
        End If
    Next i
    Worksheets(Topic).Range("A1").Resize(UBound(arr2, 1), UBound(arr2, 2)) = arr2
    
End Sub

 

[sctlippert2]

ReDim arr2(1 To LastRow, 1 To LastCol) VerseArray = Range("A1:" & LastColLetter & LastRow) 'inputs data automatically into array x = 0 For i = LBound(VerseArray, 1) To UBound(VerseArray, 1) If InStr(1, VerseArray(i, 1), Topic, vbTextCompare) <> 0 Then x = x + 1: Sheets(Topic).Select arr2(x, 1) = VerseArray(i, 1) arr2(x, 2) = VerseArray(i, 2) End If Next i

Your code as written works for me. The only changes other than what @Micron suggested would be to not go to and from and the sheet in the middle of your loop. I would also use "Option Explicit"
The altered portion of code below uses most of what you did with a few changes. The code does find the string in the array using my fictitious data...

Sub InputTopic()

    Dim LastRow As Long, LastCol As Long, LastColLetter As String
    Dim VerseArray() As Variant, i As Long, x As Long, k As Long
    Dim SourceWS As Worksheet, Topic As String, ws As Worksheet
    Dim arr2

    Topic = InputBox("Enter Topic or Word to search for...")
 
    'Check If Sheet Already Exists
    For Each ws In ThisWorkbook.Worksheets
        If InStr(1, ws.Name, Topic, vbTextCompare) <> 0 Then GoTo errorhandler:
    Next ws

    Sheets.Add(After:=Sheets(Sheets.Count)).Name = Topic
    Columns("A:A").ColumnWidth = 100                    'Columns.AutoFit
    Columns("A:A").WrapText = True
    Columns("B:B").ColumnWidth = 10

    Set SourceWS = Sheets("PROVERBS")
    SourceWS.Activate
    LastRow = ActiveSheet.UsedRange.SpecialCells(xlCellTypeVisible).Rows.Count     'FIND # of LAST Row w/ DATA
    LastCol = ActiveSheet.UsedRange.SpecialCells(xlCellTypeVisible).Columns.Count  'FIND # of LAST Column w/ DATA
    LastColLetter = Split(Cells(1, LastCol).Address, "$")(1)         'CHANGE # to Actual LETTER of COLUMN
    ReDim arr2(1 To LastRow, 1 To LastCol)
    VerseArray = Range("A1:" & LastColLetter & LastRow)   'inputs data automatically into array
    x = 0
    For i = LBound(VerseArray, 1) To UBound(VerseArray, 1)
        If InStr(1, VerseArray(i, 1), Topic, vbTextCompare) <> 0 Then
                x = x + 1: Sheets(Topic).Select
            arr2(x, 1) = VerseArray(i, 1)
            arr2(x, 2) = VerseArray(i, 2)
        End If
    Next i
    Worksheets(Topic).Range("A1").Resize(UBound(arr2, 1), UBound(arr2, 2)) = arr2
   
End Sub

Well, You said the code ran fine for you, but it is still not working for me... I revised the errorhandler code, but the second array you used is empty. I ran an extra line of code to use as a break point and then tested it in the immediate window for arr2(8,1). It was empty while versearray(8,1) had data.

Sub InputTopic2()

    Dim LastRow As Long, LastCol As Long, LastColLetter As String
    Dim VerseArray() As Variant, i As Long, x As Long, k As Long
    Dim SourceWS As Worksheet, Topic As String, ws As Worksheet
    Dim arr2

    Topic = InputBox("Enter Topic or Word to search for...")
 
    'Check If Sheet Already Exists
    For Each ws In ThisWorkbook.Worksheets
        If InStr(1, ws.Name, Topic, vbTextCompare) <> 0 Then _
            Sheets("Input Topic").Select: _
            MsgBox ("That TOPIC or Worksheet already exists... click <OK> and choose another."): _
            Exit Sub
    Next ws

    Sheets.Add(After:=Sheets(Sheets.count)).Name = Topic
    Columns("A:A").ColumnWidth = 100                    'Columns.AutoFit
    Columns("A:A").WrapText = True
    Columns("B:B").ColumnWidth = 10

    Set SourceWS = Sheets("PROVERBS")
    SourceWS.Activate
    LastRow = ActiveSheet.UsedRange.SpecialCells(xlCellTypeVisible).Rows.count     'FIND # of LAST Row w/ DATA
    LastCol = ActiveSheet.UsedRange.SpecialCells(xlCellTypeVisible).Columns.count  'FIND # of LAST Column w/ DATA
    LastColLetter = Split(Cells(1, LastCol).Address, "$")(1)         'CHANGE # to Actual LETTER of COLUMN
    ReDim arr2(1 To LastRow, 1 To LastCol)
    VerseArray = Range("A1:" & LastColLetter & LastRow)   'inputs data automatically into array
    x = 0
    For i = LBound(VerseArray, 1) To UBound(VerseArray, 1)
        If InStr(1, VerseArray(i, 1), Topic, vbTextCompare) <> 0 Then
                x = x + 1: Sheets(Topic).Select
            arr2(x, 1) = VerseArray(i, 1)
            arr2(x, 2) = VerseArray(i, 2)
        End If
    Next i
    Worksheets(Topic).Range("A1").Resize(UBound(arr2, 1), UBound(arr2, 2)) = arr2
If x = 0 Then x = 1
End Sub

 

[igold]

This does not make sense:

Well, You said the code ran fine for you, but it is still not working for me... I revised the errorhandler code, but the second array you used is empty. I ran an extra line of code to use as a break point and then tested it in the immediate window for arr2(8,1). It was empty while versearray(8,1) had data.

Considering this line of code

arr2(x, 1) = VerseArray(i, 1)

 

[igold]

What would really help is if you could post your data (real or fictitious) preferably with XL2BB, so we can see what we are dealing with. If my code works with my data and not yours, perhaps it is some issue with the data itself that we are not accounting for...

 

[Micron]

Yes, and asked for in post 10 but not provided. I'm going to unwatch now....