using loop to select cells

bobtaske

New Member
Joined
Sep 22, 2020
Messages
6
Office Version
  1. 365
Platform
  1. Windows
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. Any help would be much appreciated!

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

VBA Code:
    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

VBA Code:
    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"
 

Excel Facts

VLOOKUP to Left?
Use =VLOOKUP(A2,CHOOSE({1,2},$Z$1:$Z$99,$Y$1:$Y$99),2,False) to lookup Y values to left of Z values.
Color between
VBA Code:
Sub SelectBetween()
    Dim sh As Worksheet
    Dim r As Long, x As Long, LstRw As Long

    Set sh = ActiveSheet
    r = 1
    With sh
        LstRw = .Cells(.Rows.Count, "C").End(xlUp).Row
        For x = 1 To LstRw
            Set Rng = .Range("C" & r & ":C" & LstRw)
            On Error GoTo errhandler
            .Range(Rng.Find("test1").Offset(1), Rng.Find("test2").Offset(-1)).Interior.Color = vbGreen
            r = Rng.Find("test2").Row + 1
        Next x
        Exit Sub
errhandler:
        Resume Next
    End With
End Sub
 
Upvote 0
Color between
VBA Code:
Sub SelectBetween()
    Dim sh As Worksheet
    Dim r As Long, x As Long, LstRw As Long

    Set sh = ActiveSheet
    r = 1
    With sh
        LstRw = .Cells(.Rows.Count, "C").End(xlUp).Row
        For x = 1 To LstRw
            Set Rng = .Range("C" & r & ":C" & LstRw)
            On Error GoTo errhandler
            .Range(Rng.Find("test1").Offset(1), Rng.Find("test2").Offset(-1)).Interior.Color = vbGreen
            r = Rng.Find("test2").Row + 1
        Next x
        Exit Sub
errhandler:
        Resume Next
    End With
End Sub
thanks!
 
Upvote 0
See if this program works for you. Now maybe we will get some of the A Students to weigh in.

VBA Code:
Sub test1()
Dim findrow As Long, findrow2 As Long
Dim LastRow As Long

LastRow = Cells(Rows.Count, "C").End(xlUp).Row

    On Error GoTo errhandler
  
For row1 = 1 To LastRow

If Cells(row1, 3) = "teston" Then
    findrow = Range("C:C").Find("teston", Range("C" & row1 - 1)).Row
    findrow2 = Range("C:C").Find("testoff", Range("C" & row1)).Row
    Range("F" & findrow + 1 & ":F" & findrow2 - 1).Select
        With Selection.Interior
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
                .Color = 16764159
                .TintAndShade = 0
                .PatternTintAndShade = 0
        End With
End If

Next row1

Cells(row1, 3).Select
Exit Sub
errhandler:
    MsgBox "No Cells containing specified text found"

End Sub

20-09-22 Teston off A.xlsm
CDEF
11
22
33
4teston
54
65
76
8testoff
97
108
119
12teston
1310
1411
1512
1613
1714
18testoff
1915
2016
Test on & off
 
Upvote 0
Now maybe we will get some of the A Students to weigh in.
The code by davesexcel works fine, it is just he is using test1 and test2 which the OP used in their 2nd code rather than teston and testoff.
 
Upvote 0

Forum statistics

Threads
1,213,538
Messages
6,114,217
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top