VBA code to search for a string in an array

Ria_Ko

New Member
Joined
Mar 18, 2020
Messages
43
Office Version
  1. 365
  2. 2019
  3. 2016
Platform
  1. Windows
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.

VBA Code:
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
 
Last edited by a moderator:

Excel Facts

Using Function Arguments with nested formulas
If writing INDEX in Func. Arguments, type MATCH(. Use the mouse to click inside MATCH in the formula bar. Dialog switches to MATCH.
In future please sue code tags when posting code. It's the <vba/> icon in the reply window.
How about
VBA Code:
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
 
Upvote 0
In future please sue code tags when posting code. It's the <vba/> icon in the reply window.
How about
VBA Code:
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?
 
Upvote 0
I did modify you code.
When posting code click the <vba/> icon in the reply window & paste your code between the tags that appear.
 
Upvote 0
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?
 
Upvote 0
I did modify your code, so that it worked.
 
Upvote 0
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
 
Upvote 0
replace
VBA Code:
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
VBA Code:
Range("E" & k).Resize(, 3).Value = Array(wrd, i, j)
 
Upvote 0
replace
VBA Code:
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
VBA Code:
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.
 

Attachments

  • Screenshot (14).png
    Screenshot (14).png
    225.5 KB · Views: 76
Upvote 0
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

VBA Code:
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.
 
Last edited by a moderator:
Upvote 0

Forum statistics

Threads
1,223,889
Messages
6,175,224
Members
452,620
Latest member
dsubash

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top