selecting multiple different ranges in a loop VBA

Question

I'm new to VBA and I'm trying to make a macro that searches through column C finds all the cells containing "teston" then finds the cell below it containing "testoff" and highlights all of the cells in between them in the column next to it. there are multiple instances of teston to testoff.

this code works but only highlights the first instance of teston to testoff

    Dim findrow As Long, findrow2 As Long


    On Error GoTo errhandler


    findrow = Range("C:C").Find("teston", Range("C1")).Row
    findrow2 = Range("C:C").Find("testoff", Range("C" & findrow)).Row
    Range("F" & findrow + 1 & ":F" & findrow2 - 1).Select
        With Selection.Interior
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
                .Color = 16764159
                .TintAndShade = 0
                .PatternTintAndShade = 0
              End With
errhandler:
    MsgBox "No Cells containing specified text found"

This is what i tried to do to highlight them all but it doesn't highlight anything

    Range("A1").Select
    Selection.End(xlDown).Select
    Dim lastcell As Long
    lastcell = ActiveCell.Row
    
    Dim findrow As Long, findrow2 As Long, I As Long, inext As Long
    
    inext = 1
    
    On Error GoTo errhandler
    
      Do While I < lastcell
              
            findrow = Range("C" & inext & ":" & "C" & lastcell).Find("test1", Range("C1")).Row
            findrow2 = Range("C" & inext & ":" & "C" & lastcell).Find("test2", Range("C" & findrow)).Row
            Range("F" & findrow + 1 & ":F" & findrow2 - 1).Select
                With Selection.Interior
                        .Pattern = xlSolid
                        .PatternColorIndex = xlAutomatic
                        .Color = 16764159
                        .TintAndShade = 0
                        .PatternTintAndShade = 0
                End With
            Range("findrow2").Select
            inext = ActiveCell.Row
            findrow = findrow2
                I = I + 1
       Loop
              
errhandler:
    MsgBox "No Cells containing specified text found"

What range should your macro fill if column C contains several testons and only one testoff? — JohnSUN
– JohnSUN, Commented Sep 23, 2020 at 1:57
I didn't notice this line right away - Range("findrow2").Select. What it does? More precisely, what do you think it should do? — JohnSUN
– JohnSUN, Commented Sep 23, 2020 at 6:34
What I mean is that whatever the named range "findrow2" is, inext always points to this row and does not shift in loop - so you only paint the first test1/test2 pair. And this named range must be there, otherwise you will go to errhandler: Or are you really going there? — JohnSUN
– JohnSUN, Commented Sep 23, 2020 at 8:34
i was trying to grab the cell row of findrow2 by selecting it ` Range("findrow2").Select ` then grabbing cell value and setting that to inext so the next loop starts at inext and goes down from there — BobTaske
– BobTaske, Commented Sep 25, 2020 at 4:56
Ah, maybe you wanted to write inext = Range("C" & findrow2).Row or simple inext = findrow2? — JohnSUN
– JohnSUN, Commented Sep 25, 2020 at 5:03

JohnSUN · Accepted Answer · 2020-09-23 02:33:14Z

1

Don't look for them separately. Just go through the entire column and they will be found by themselves.

Sub color_between_tests()
Dim tSearch As Range
Dim oCell As Range
Dim bColorOn As Boolean
    Set tSearch = Application.Intersect(ActiveSheet.UsedRange, ActiveSheet.Columns("C"))
    bColorOn = False
    For Each oCell In tSearch
        oCell.Offset(0, 3).Interior.Color = 16764159
        Select Case oCell.Text
            Case "teston"
                bColorOn = True
            Case "testoff"
                bColorOn = False
            Case Else
                If Not bColorOn Then oCell.Offset(0, 3).Interior.Pattern = xlNone
        End Select
    Next oCell
End Sub

answered Sep 23, 2020 at 2:33

JohnSUN

2,5692 gold badges7 silver badges19 bronze badges

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

5 Comments

BobTaske Over a year ago

Thanks this worked but it took a few min to execute and I'm trying to make it run faster, I'm not sure what my original code looked like it was doing but i was trying to go down from C1 to find the first case at lets say C54 to C86 then start the search "again" but start at C86 to find the next teston, i'm also trying to figure out why my original code didn't work because from my limited knowledge it looks like it should work just fine

JohnSUN Over a year ago

Using Application.ScreenUpdating = False before the loop and Application.ScreenUpdating = True before exiting the procedure should solve the long execution problem. To continue searching from a given location, findrow must contain Range("C" & findrow2) instead of Range("C1") (remember to set findrow2 = 1 before starting the search!)

BobTaske Over a year ago

Thanks i tried 'Range("C" & findrow2)' before but i forgot to set 'findrow2 = 1' before so nothing happend i guess. should i be using 'Application.ScreenUpdating = False' and 'Application.ScreenUpdating = False' all the time for other macros as well to speed them up?

BobTaske Over a year ago

i just tried setting it to 1 and replacing C1 with "C" & findrow2 but it only highlights the first case even though i'm having it loop 10 times

JohnSUN Over a year ago

About .ScreenUpdating see HERE

Zer0Kelvin · Accepted Answer · 2020-09-23 08:21:19Z

1

This should improve the speed

Dim oCell As Range
Dim R As Long
Dim Color_On As Boolean

R = Cells(Rows.Count, 3).End(xlUp).Row
Range("F1:F" & R).Interior.Pattern = xlNone
For Each oCell In Range("C1:C" & R)
    Color_On = oCell = "teston" Or Color_On
    If Color_On Then oCell.Offset(0, 3).Interior.Color = 16764159
    Color_On = Color_On And (oCell <> "testoff")
Next oCell

answered Sep 23, 2020 at 8:21

Zer0Kelvin

3742 silver badges7 bronze badges

2 Comments

BobTaske Over a year ago

thanks so much this worked fantastically! is there a reason why this way only takes about a second to run while the other ones would take around 5 min?

Zer0Kelvin Over a year ago

It's a "rigged" code. ; ) Seriously: fewer instructions, fewer comparisons and fewer assignments = faster code.

Tim Williams · Accepted Answer · 2020-09-23 02:18:17Z

0

Try this - assumes every teston is followed by a testoff, and there's no nesting of value pairs

Sub Tester()

    Dim rngSrch As Range, ws As Worksheet, allOn As Collection, c As Range, c2 As Range
    
    Set ws = ActiveSheet
    Set rngSrch = ws.Columns("C")
    
    Set allOn = FindAll(rngSrch, "teston") 'first find all the "teston"
    For Each c In allOn
        'for each one find the next "testoff"
        Set c2 = rngSrch.Find("testoff", after:=c, lookat:=xlWhole)
        If Not c2 Is Nothing Then
            If c2.Row > c.Row Then
                ws.Range(c.Offset(1, 3), c2.Offset(-1, 3)).Interior.Color = vbYellow
            Else
                Exit For 'wrapped back up - exit
            End If
        End If
    Next c
    
End Sub

'find all matches in a given range
Public Function FindAll(rng As Range, val As String) As Collection
    Dim rv As New Collection, f As Range, addr As String
    Set f = rng.Find(what:=val, after:=rng.Cells(rng.Cells.Count), _
        LookIn:=xlValues, lookat:=xlWhole, SearchOrder:=xlByRows, _
        SearchDirection:=xlNext, MatchCase:=False)
    If Not f Is Nothing Then addr = f.Address()
    Do Until f Is Nothing
        rv.Add f
        Set f = rng.FindNext(after:=f)
        If f.Address() = addr Then Exit Do
    Loop
    Set FindAll = rv
End Function

answered Sep 23, 2020 at 2:18

Tim Williams

169k8 gold badges104 silver badges143 bronze badges

2 Comments

BobTaske Over a year ago

i tried this it executed for a min or two but nothing was highlighted after it finished

Tim Williams Over a year ago

Works fine for me.

Collectives™ on Stack Overflow

selecting multiple different ranges in a loop VBA

3 Answers 3

5 Comments

2 Comments

2 Comments

Your Answer

Linked

Hot Network Questions

Collectives™ on Stack Overflow

3 Answers 3

5 Comments

2 Comments

2 Comments

Your Answer

Sign up or log in

Post as a guest

Linked

Related