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]

The first of those lines is wron because you are using k as the index rather than i, otherwise I'm not sure what you are saying is wrong.

 

[Ria_Ko]

The first of those lines is wron because you are using k as the index rather than i, otherwise I'm not sure what you are saying is wrong.

Okay, il try to figure it out. Your code definitely works so thank you alot for your help. It means alot that you tried to help me at your best. Have a great day. Take care.

 

[Fluff]

I am more than happy to continue, but I don't understand what you problem is.
Do you need to clear columns E:G every time you run the code?
Do you need to add data to E:G every time, rather than overwrite?
Or is it something else?

 

[Ria_Ko]

I am more than happy to continue, but I don't understand what you problem is.
Do you need to clear columns E:G every time you run the code?
Do you need to add data to E:G every time, rather than overwrite?
Or is it something else?

Whenever i run the code, i want the results in column E,F,G and not in any other columns. So when i increase the size of the old array from which the new array is created, if i add a column to the old array, the results should not shift from columns E,F,G when i run the code. So if my old array is 3x3 and now i increase it to 3x4 this should not shift my results to any other column when i run the same code.
If you still don’t understand il again try to explain

 

[Fluff]

Your code from post#18 will only put the result in columns E,F & G.

 

[Ria_Ko]

Your code from post#18 will only put the result in columns E,F & G.

Yes it will, but when i increase the size of my old array, the elements shift since i used offset previously... so not using offset how can i fix the columns for any sized old array..

 

[Fluff]

Ok, rather than putting the results in E,F & G you want them to one side, so if the data was in A:E the results should be in G:I?

 

[Fluff]

If the answer to the above question is yes, try

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

With Selection
   j = .Columns.Count
   For i = 1 To k
      .Cells(i, j + 2) = w(i)
      .Cells(i, j + 3) = rowindex(i)
      .Cells(i, j + 4) = colindex(i)
   Next i
End With

End If
End Sub

 

[Ria_Ko]

If the answer to the above question is yes, try

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

With Selection
   j = .Columns.Count
   For i = 1 To k
      .Cells(i, j + 2) = w(i)
      .Cells(i, j + 3) = rowindex(i)
      .Cells(i, j + 4) = colindex(i)
   Next i
End With

End If
End Sub

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
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

Range("E" & CStr(i)) = w(i)
Range("F" & CStr(i)) = rowindex(i)
Range("G" & CStr(i)) = colindex(i)

Next i
End If
End Sub

Hi Fluff, i finally got the right code lines. So i fixed the columns E,F,G even if i add an extra column D in my old array, the elements will come in column E,F,G. I apologise for having not been able to explain you my requirements correctly but i am very thankful for your help and efforts.

 

[Fluff]

Glad you got it sorted & thanks for the feedback.