loop to get list of values that have a partial match

[Michael Ziegler]

I'm trying to get a list of the content of all the cells that are partial match to to a specific range find but is not working. Here is my code snippet

Option Explicit


Sub OpenXcl()


Dim AppExcel As Object

Dim NetWorkbook As Excel.Workbook

Dim NetWrksht As Excel.Worksheet

Dim vsoShape As Visio.Shape

Dim DiagramServices As Integer

Set AppExcel = CreateObject("Excel.application")

AppExcel.Workbooks.Open "C:\Users\michael\Documents\Working.xlsx"
AppExcel.Visible = True


Dim rngToSearch As Variant
Dim selectedCell As Range


Dim WhatToFind As Variant


WhatToFind = Array("boston", "gordon", "housatonic", "barb")


Set rngToSearch = Range("A:A").Find(What:=WhatToFind, LookIn:=xlValues, Lookat:=xlPart)


For Each NetWrksht In ActiveWorkbook.Worksheets


If Not rngToSearch Is Nothing Then



MsgBox rngToSearch


Else

MsgBox "End"

End If

Next

ActiveWorkbook.Close SaveChanges:=False



End Sub