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

 

[Fluff]

In future please sue code tags when posting code. It's the <vba/> icon in the reply window.
How about

Sub SearchForString()

   Dim nr As Long, nc As Long, Txt As String, i As Integer, j As Long, Wrd As String, k As Long
   
   nr = Selection.Rows.Count
   nc = Selection.Columns.Count
   Txt = InputBox("enter the string to search for")
   For i = 1 To nr
      For j = 1 To nc
         Wrd = Selection.Cells(i, j).Text
         If InStr(1, Wrd, Txt, vbTextCompare) > 0 Then
            k = k + 1
            Range("E" & k).Resize(, 3).Value = Array(Selection.Cells(i, j).Value, i, j)
         End If
      Next j
   Next i
End Sub

 

[Ria_Ko]

In future please sue code tags when posting code. It's the <vba/> icon in the reply window.
How about

Sub SearchForString()

   Dim nr As Long, nc As Long, Txt As String, i As Integer, j As Long, Wrd As String, k As Long
  
   nr = Selection.Rows.Count
   nc = Selection.Columns.Count
   Txt = InputBox("enter the string to search for")
   For i = 1 To nr
      For j = 1 To nc
         Wrd = Selection.Cells(i, j).Text
         If InStr(1, Wrd, Txt, vbTextCompare) > 0 Then
            k = k + 1
            Range("E" & k).Resize(, 3).Value = Array(Selection.Cells(i, j).Value, i, j)
         End If
      Next j
   Next i
End Sub

Hi Fluff, thank you for your help but pardon me i did not understand what did you mean by sue code tags?
And also, can you write a code by modifying my code so that i can understand my mistake?

 

[Fluff]

I did modify you code.
When posting code click the <vba/> icon in the reply window & paste your code between the tags that appear.

 

[Ria_Ko]

Okay i will do that from next time onwards. Can you help me with the code by modifying the code i sent so that i can understand better?

 

[Fluff]

I did modify your code, so that it worked.

 

[Ria_Ko]

I did modify your code, so that it worked.

Hi Yes you did give me the right code thanks alot for that but by modify i meant to ask you to give me the same code by just changing the part where i have made a mistake so that i can come to know what exactly i did not know to get my code right.
Thankyou

 

[Fluff]

replace

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

with

Range("E" & k).Resize(, 3).Value = Array(wrd, i, j)

 

[Ria_Ko]

replace

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

with

Range("E" & k).Resize(, 3).Value = Array(wrd, i, j)

Hi Fluff, i tried the code which you gave but it doesn’t give me the required results. I will attach an image that might help you in understanding what result i need.

 

[Ria_Ko]

Hi Fluff, i tried the code which you gave but it doesn’t give me the required results. I will attach an image that might help you in understanding what result i need.

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.