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]

You don't need that, just use the code I supplied.

 

[Ria_Ko]

Hi Fluff, your help is much appreciated but the code that you sent does not satisfy the answer i am looking for. I again tried to tweak my code but i am going wrong somewhere.
If anyone could help me out it would be great.

Here's my code:

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

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

w(k) = wrd
rowindex(k) = i
colindex(k) = j

Exit For
End If
Next z
Next j
Next i

If k <> 0 Then
Selection.Cells(1, 1).Select

For i = 1 To k
ActiveCell.Offset(k - 1, nc + 2) = rowindex(i)
ActiveCell.Offset(k - 1, nc + 3) = colindex(i)
ActiveCell.Offset(k - 1, nc + 1) = w(i)

Next i
End If
End Sub

 

[Fluff]

In what way doesn't either of the codes I supplied "does not satisfy the answer i am looking for"

 

[Ria_Ko]

In what way doesn't either of the codes I supplied "does not satisfy the answer i am looking for"

When i run the code, it doesnt give the results shown in the image i have attached. For example, if the string is "arm" it should list all the words that contain the word "arm" along with their rowindex and columnindex.
When i run your code this doesn't happen.

 

[Fluff]

When i run the code from post#2 or the mod I suggested in post#8 I get these results.

+Fluff New.xlsm
	A	B	C	D	E	F	G	H	I	J	K
1	Charming	production	pharmacy		Macro post#2				Macro post#8
2	produce	hello	geology		Charming	1	1		Charming	1	1
3	picture	harmful	brake		pharmacy	1	3		pharmacy	1	3
4	computing	canada	subject		harmful	3	2		harmful	3	2
5	geography	mouse	farmer		farmer	5	3		farmer	5	3
Lookup

In what way are they wrong?

 

[Ria_Ko]

Hey

When i run the code from post#2 or the mod I suggested in post#8 I get these results.

+Fluff New.xlsm
	A	B	C	D	E	F	G	H	I	J	K
1	Charming	production	pharmacy		Macro post#2				Macro post#8
2	produce	hello	geology		Charming	1	1		Charming	1	1
3	picture	harmful	brake		pharmacy	1	3		pharmacy	1	3
4	computing	canada	subject		harmful	3	2		harmful	3	2
5	geography	mouse	farmer		farmer	5	3		farmer	5	3
Lookup

In what way are they wrong?

hey, when you told me to replace redim preserve with your code line "range("E")..." it did not work. But your code as a whole works. I am sorry to bother you so much but I just need one last advice if you could help. So i have got my code working but can you explain how do i place the line of code to place results in column E,F,G ONLY even if the size of array increases? When i increase the size of my array, the results shirt one column right which is not what i want. I want my results to stick to columns E,F,G..
thankyou

 

[Fluff]

What is your code at the moment.
When you post it, please use code tags as previously explained.

How to Post Your VBA Code

Post your VBA code.

www.mrexcel.com

 

[Ria_Ko]

What is your code at the moment.
When you post it, please use code tags as previously explained.

How to Post Your VBA Code

Post your VBA code.

www.mrexcel.com

Option Explicit

Sub SearchForString()

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 w() As Variant, rowindex() As Integer, colindex() As Integer

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

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

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

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

ReDim Preserve w(k) As Variant
ReDim Preserve rowindex(k) As Integer
ReDim Preserve colindex(k) As Integer

w(k) = Selection.Cells(i, j).Text
rowindex(k) = i
colindex(k) = j

Exit For
End If
Next z
Next j
Next i

If k <> 0 Then
Selection.Cells(1, 1).Select

For i = 1 To k
[B]Range("E" & i) = w(k)
Range("F" & i) = rowindex(i)
Range("G" & i) = colindex(i)[/B]

Next i
End If
End Sub

This is my current code. The 3 lines starting from "range("E" & i .......colindex(i)" are wrong, i need to write a code line that does not shift element from E,F,G when my old array is increased in size.

 

[Fluff]

Do you mean you want to keep the existing result & output the new result underneath?

 

[Ria_Ko]

N

Do you mean you want to keep the existing result & output the new result underneath?

No, i want to replace those 3 lines with the correct code lines.