search for string and then set range

[puukoi]

Hi
I looking for code how to find text.

I like to find from col B text1.If text1 in the cells B10, B38, B100, B121...etc how could I set ranges from first text1 to second text1(rng1), from second text1 to third text1(rng2)...etc.
In this case the ranges should be:rng1("B10:B37"), rng2("B38:B99")..etc.
Then I would like to find text2 fm rng 1, if not found then from rng2..etc
Any Ideas

 

[VBA Geek]

you can set the ranges this way, the array aRanges will hold all your ranges, if in col B the text you are looking for is found

Sub SetRanges2()
Const txtToFind = "text1"
Dim aRanges() As Excel.Range, K As Long, aMatches As Variant

aMatches = Filter(Evaluate(Replace("=TRANSPOSE(IF(B1:B@=""" & txtToFind & """,ADDRESS(ROW(B1:B@),2,4,1),""^&^&^&""))", "@", Range("b" & Rows.Count).End(xlUp).Row)), "^&^&^&", 0)
If Not UBound(aMatches) = -1 Then
    ReDim aRanges(0 To UBound(aMatches))
    For K = LBound(aMatches) To UBound(aMatches) - 1
        Set aRanges(K) = Range(aMatches(K) & ":B" & Mid$(aMatches(K + 1), 2) - 1)
    Next K
    Set aRanges(UBound(aMatches)) = Range(aMatches(UBound(aMatches)))
End If
End Sub

 

[puukoi]

Thank you!
Thist is great! This is what I've been looking for. Just one thing.It is my fault that I did't explain it right away the first time
Now the code hold all ranges until the last "text1". How it is possible to hold the last range also, from last "txt1" to the last used row

 

[VBA Geek]

try it like this:

Sub SetRanges2()
Const txtToFind = "text1"
Dim aRanges() As Excel.Range, K As Long, aMatches As Variant, lRow As Long
lRow = Range("B" & Rows.Count).End(xlUp).Row

aMatches = Filter(Evaluate(Replace("=TRANSPOSE(IF(B1:B@=""" & txtToFind & """,ADDRESS(ROW(B1:B@),2,4,1),""^&^&^&""))", "@", Range("b" & Rows.Count).End(xlUp).Row)), "^&^&^&", 0)

If Not UBound(aMatches) = -1 Then
    ReDim aRanges(0 To UBound(aMatches))
    For K = LBound(aMatches) To UBound(aMatches) - 1
        Set aRanges(K) = Range(aMatches(K) & ":B" & Mid$(aMatches(K + 1), 2) - 1)
    Next K
    Set aRanges(UBound(aMatches)) = Range(aMatches(UBound(aMatches) & ":B" & lRow))
End If

End Sub

Thank you!
Thist is great! This is what I've been looking for. Just one thing.It is my fault that I did't explain it right away the first time
Now the code hold all ranges until the last "text1". How it is possible to hold the last range also, from last "txt1" to the last used row

 

[puukoi]

Hi again and thank you for very quick replay. The line:

Set aRanges(UBound(aMatches)) = Range(aMatches(UBound(aMatches) & ":B" & lRow))
gives an error "Run-time error '13':Type mismatch

Sub SetRanges2()
Const txtToFind = "text1"
Dim aRanges() As Excel.Range, K As Long, aMatches As Variant, lRow As Long
lRow = Range("B" & Rows.Count).End(xlUp).Row

aMatches = Filter(Evaluate(Replace("=TRANSPOSE(IF(B1:B@=""" & txtToFind & """,ADDRESS(ROW(B1:B@),2,4,1),""^&^&^&""))", "@", Range("b" & Rows.Count).End(xlUp).Row)), "^&^&^&", 0)

If Not UBound(aMatches) = -1 Then
    ReDim aRanges(0 To UBound(aMatches))
    For K = LBound(aMatches) To UBound(aMatches) - 1
        Set aRanges(K) = Range(aMatches(K) & ":B" & Mid$(aMatches(K + 1), 2) - 1)
    Next K
    Set aRanges(UBound(aMatches)) = Range(aMatches(UBound(aMatches) & ":B" & lRow))
End If

End Sub

[/QUOTE]

 

[VBA Geek]

thats right, parenthesis issue


use:

Set aRanges(UBound(aMatches)) = Range(aMatches(UBound(aMatches)) & ":B" & lRow)

 

[puukoi]

Hi again!

In this caseis the same issue than first time,do not hold the range from last "text1".

 

[VBA Geek]

the last element of the array is the range from the last text1 until the last elemnt in column B

 

[puukoi]

Sorry, my mistake. Now I can go ahead with my projct
Thank you once again