VBA code to search for a string in an array

Ria_Ko

New Member
Joined
Mar 18, 2020
Messages
43
Office Version
365, 2019, 2016
Platform
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:

Some videos you may like

Excel Facts

Which Excel functions can ignore hidden rows?
The SUBTOTAL and AGGREGATE functions ignore hidden rows. AGGREGATE can also exclude error cells and more.

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
40,572
Office Version
365
Platform
Windows
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
 

Ria_Ko

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

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
40,572
Office Version
365
Platform
Windows
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

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

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
40,572
Office Version
365
Platform
Windows
I did modify your code, so that it worked.
 

Ria_Ko

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

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
40,572
Office Version
365
Platform
Windows
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)
 

Ria_Ko

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

Ria_Ko

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

Watch MrExcel Video

Forum statistics

Threads
1,098,918
Messages
5,465,429
Members
406,427
Latest member
gboomer

This Week's Hot Topics

Top