Look for substring within Excel range VBA

Question

I have an input text string in a range (from A1 to AV1), each letter in one cell. The string is

From A1 to AV1 look like this

  | A B C D E F G H I J K L M N O P Q R S T U V W X Y Z AA AB AC AD AE AF AG AH AI AJ AK AL AM AN AO AP AQ AR AS AT AU AV
--------------------------------------------------------------------------------------------------------------------------
1 | M i c r o s o f t E x c e l i s a s p r e a d s h e e  t  d  e  v  e  l  o  p  e  d  b  y  M  i  c  r  o  s  o  f  t

I want to be able to search for a substring and if found, select the range where the substring is present.

My current code below it works if the input text string is in the same row, but I'm stuck in how to do if the string is in different rows, for example if the same input text string is in range A1:O4 and I want to search the substring "developed" which begins in N2 and ends in G3.

Sub SelectRangeofSubString()
Rng = Range("A1:AV1")

a = Range("A1").CurrentRegion
aa = WorksheetFunction.Transpose(WorksheetFunction.Transpose(a))
str1 = Join(aa, "")

StringToSearch = "developed"
StringLength = Len(StringToSearch)
Pos = InStr(str1, StringToSearch)

Range(Cells(1, Pos), Cells(1, Pos + StringLength - 1)).Select

End Sub

From A1 to O4 look like this

  | A   B   C   D   E   F   G   H   I   J   K   L   M   N   O
---------------------------------------------------------------
1 | M   i   c   r   o   s   o   f   t   E   x   c   e   l   i
2 | s   a   s   p   r   e   a   d   s   h   e   e   t   d   e
3 | v   e   l   o   p   e   d   b   y   M   i   c   r   o   s
4 | o   f   t

Thanks for any help

Update

Thanks both. It works in both solutions. My last issue, I tried the same when each cell contains 2 letters, May you help me to select the range in this case too?

For example the stringToSearch = "developed" and data is from range A1:H3

    A   B   C   D   E   F   G   H
----------------------------------
1 | Mi  cr  os  of  tE  xc  el  is
2 | as  pr  ea  ds  he  et  de  ve
3 | lo  pe  db  yM  ic  ro  so  ft

Ryan Wildry · Accepted Answer · 2019-01-10 00:19:13Z

1

I made this ask into a little subroutine that will take a SearchRange and SearchString as parameters.

The subroutine will select the cells where the first match was found. It should be easy to switch this around if you wanted to return the Range object instead.

Private Sub FindWord(SearchRange As Range, SearchString As String)
    Dim LetterArray         As Variant
    Dim RangeArray          As Variant
    Dim ws                  As Worksheet
    Dim Letter              As Range
    Dim i                   As Long
    Dim SelectedRng         As Range
    Dim StringPosition      As Long
    Dim LastSearchIndex     As Long

    ReDim LetterArray(1 To SearchRange.Cells.Count)
    ReDim RangeArray(1 To SearchRange.Cells.Count)
    Set ws = SearchRange.Parent

    For Each Letter In SearchRange
        i = i + 1
        LetterArray(i) = Letter.Value2
        RangeArray(i) = Letter.Address
    Next

    StringPosition = InStr(1, Join(LetterArray, vbNullString), SearchString)
    If StringPosition <= 0 Then Exit Sub
    LastSearchIndex = Len(SearchString) + StringPosition - 1

    For i = StringPosition To LastSearchIndex
        If SelectedRng Is Nothing Then
            Set SelectedRng = ws.Range(RangeArray(i))
        Else
            Set SelectedRng = Union(SelectedRng, ws.Range(RangeArray(i)))
        End If
    Next

    SelectedRng.Select
End Sub

Sub SelectIt()
    Dim rng As Range
    Set rng = ThisWorkbook.Sheets("Sheet1").Range("A1:D4")

    FindWord rng, "developed"
End Sub

Edit

Updated this to handle 2 or more characters in one cell. This should work for up to N characters, however I only briefly tested this out. I hope it helps. I'll leave the other method for posterity.

I should mention this revised method does assume all cells have the same number of characters in them. If that isn't true, it likely won't work.

Private Sub FindWord(SearchRange As Range, SearchString As String, Optional CharacterLength As Long = 1)
    Dim LetterArray         As Variant
    Dim RangeArray          As Variant
    Dim ws                  As Worksheet
    Dim Letter              As Range
    Dim i                   As Long
    Dim SelectedRng         As Range
    Dim StringPosition      As Long
    Dim LastSearchIndex     As Long

    ReDim LetterArray(1 To SearchRange.Cells.Count)
    ReDim RangeArray(1 To SearchRange.Cells.Count)
    Set ws = SearchRange.Parent

    For Each Letter In SearchRange
        i = i + 1
        LetterArray(i) = Letter.Value2
        RangeArray(i) = Letter.Address
    Next

    StringPosition = WorksheetFunction.RoundUp((InStr(1, Join(LetterArray, vbNullString), SearchString) / CharacterLength), 0)
    If StringPosition <= 0 Then Exit Sub
    LastSearchIndex = WorksheetFunction.RoundUp((Len(SearchString) / CharacterLength), 0) + StringPosition - 1

    For i = StringPosition To LastSearchIndex
        If SelectedRng Is Nothing Then
            Set SelectedRng = ws.Range(RangeArray(i))
        Else
            Set SelectedRng = Union(SelectedRng, ws.Range(RangeArray(i)))
        End If
    Next

    SelectedRng.Select
End Sub

Sub SelectIt()
    Dim rng As Range
    Set rng = ThisWorkbook.Sheets("Sheet1").Range("A1:D4")

    FindWord rng, "developed", 2
End Sub

edited Jan 10, 2019 at 0:19

answered Jan 9, 2019 at 21:17

Ryan Wildry

5,6971 gold badge17 silver badges36 bronze badges

Sign up to request clarification or add additional context in comments.

6 Comments

Ger Cas Over a year ago

Hi Ryan, your solution works fine, may you see my update in my post. It could be possible to consider the case when the cells have 2 letters either?

Ger Cas Over a year ago

Only can I say, wonderful! It works so nice. Thanks so much for your help Ryan. Regards

Ger Cas Over a year ago

I only found an issue, with long substrings it seems is not selecting all the range for that string. For example if the substring to search within the range has a length of 2500 characters only selects 127 cells and should be 1250 cells, since each cell has 2 characters. May you help me to fix this? If not thanks anyway for your great help. You can test in a range from A1:AP50 (40 columns, 50 rows) and a substring of 1000 or more characters.

Ryan Wildry Over a year ago

@GerCas Only thing I can think that would cause that is if each cell contains a different number of characters in your range, check that first. I don't think this approach works unless each cell has the same number of characters in it.

Ger Cas Over a year ago

Yes Ryan. I'm testing with hexadecimal number, all are of 2 characters. For example 01, A9, 12, 00, BD in each cell and all cells formated as text.

|

Storax · Accepted Answer · 2019-01-09 21:00:00Z

1

I modified your code based on the information that we have to look ar Range("A1:O4")

Sub SelectRangeofSubString()
Dim rng As Range
Dim a, str1, stringtosearch, stringlength, pos
Dim i As Long, j As Long
    Set rng = Range("A1:O4")

    a = rng ' Range("A1").CurrentRegion
    'aa = WorksheetFunction.Transpose(WorksheetFunction.Transpose(a))
    For i = LBound(a, 1) To UBound(a, 1)
        For j = LBound(a, 2) To UBound(a, 2)
            str1 = str1 & a(i, j)
        Next
    Next

    stringtosearch = "developed"
    stringlength = Len(stringtosearch)
    pos = InStr(str1, stringtosearch)

    Dim resRg As Range
    Set resRg = rng.Item(pos)
    For i = pos + 1 To pos + Len(stringtosearch) - 1
        Set resRg = Union(resRg, rng.Item(i))
    Next i
    resRg.Select

End Sub

answered Jan 9, 2019 at 21:00

Storax

12.7k3 gold badges21 silver badges36 bronze badges

2 Comments

Ger Cas Over a year ago

Hi Storax, your solution works fine, may you see my update in my post. It could be possible to consider the case when the cells have 2 letters either?

Storax Over a year ago

@Ger Cas: If you have additional questions I'd suggest to create a new post.

Collectives™ on Stack Overflow

Look for substring within Excel range VBA

2 Answers 2

6 Comments

2 Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

2 Answers 2

6 Comments

2 Comments

Your Answer

Sign up or log in

Post as a guest

Related