VBA code to search for a string in an array

[Ria_Ko]

Hi everyone, hope all are doing well.

I have to create a VBA subroutine called SearchForString that will search through a selection for a user-defined sub-string. The subroutine will then output (starting in cell E1) all words in the original selection that have the sub-string. If there are no matches, a message box should alert the user. Furthermore, the subroutine should output the row number and column numbers of the location in the original selection in which the sub-string was found. These indices should be output to the right of any matching words (row indices starting in cell F1 and column indices starting in cell G1). The flow charts below will help you greatly. NOTE: The subroutine should work for *any* selection on the worksheet and for any size of selection, and the output/results should ALWAYS start in E1 to G1 (and rows immediately below for multiple matches).
I tried to write the code but i think my code doesnt adjust for ***any sized array***. Any help would be appreciated.

Option Explicit

Sub SearchForString()

Dim nr As Integer, nc As Integer, str As String, s As Integer, i As Integer, j As Integer, wrd As String, ws As Integer, z As Integer, k As Integer

Dim w() As Variant, rowindex() As Variant, colindex() As Variant, c As Integer

Dim switch As Boolean

nr = Selection.Rows.Count

nc = Selection.Columns.Count

str = InputBox("enter the string to search for")

s = Len(str)

For i = 1 To nr

For j = 1 To nc

wrd = Selection.Cells(i, j).Text

ws = Len(wrd)

For z = 1 To ws - s + 1

If Mid(wrd, z, s) = str Then

switch = True

k = k + 1

ReDim Preserve w(k) As Integer

ReDim Preserve rowindex(k) As Integer

ReDim Preserve colindex(k) As Integer

Selection.Cells(1, 1).Select

ActiveCell.Offset(k - 1, nc + 1) = Selection.Cells(i, j).Text

ActiveCell.Offset(k - 1, nc + 2) = i

ActiveCell.Offset(k - 1, nc + 3) = j

Exit For

End If

Next z

Next j

Next i


End Sub

Many thanks,
Ria

 

[Muhammad Mateen]

Option Explicit

Sub ABC()

Dim i As Integer, j As Integer, z As Integer, k As Integer
Dim nr As Integer, nc As Integer
Dim Lstr As Integer, Lwrd As Integer
Dim str As String, wrd As String
Dim switch As Boolean
Dim w() As Integer, rowindex() As Integer, colindex() As Integer

str = InputBox("Please enter a string")
nr = Selection.Rows.Count
nc = Selection.Columns.Count
Lstr = Len(str)

For i = 1 To nr
For j = 1 To nc

wrd = Selection.Cells(i, j)
Lwrd = Len(wrd)

For z = 1 To Lwrd
If Mid(wrd, z, Lstr) = str Then
k = k + 1
switch = True

Else
switch = False
MsgBox ("Sorry no match found")

ReDim Preserve w(k)
ReDim Preserve rowindex(k)
ReDim Preserve colindex(k)

[B]w(k) =
rowindex(k) =
colindex(k) =[/B]

Exit For
End If
Next z
Next j
Next i

End Sub

I am having problem in solving the bold texts.

did you get your correct code?