'Loop to color row when string found

This works when run the first time.

InStr(Worksheets("tickets").Cells(i, 4).Value, "Provided feedback") Then

Upon the second time, it will not only find it's search string and color the row as it should, but it also colors everything else the same color as if it was found. It colors all the others that weren't chosen the same color.

I can change "Provided feedback", to "feedback", "provided, and it will do the same, all on the 2nd run.
If I put something in the row to search for like "dookie", it won't find anything (as expected), run it again and it still finds nothing (as expected).
If I use a row that it shouldn't find, say one that has "VM" in the cell. And I change the above code to look for "VM" instead of "feedback" or one of the other search strings, it will only find that row, as expected.

Sub tix_import()
'
' tix_import Macro
'

Worksheets("tickets").Cells.Select
Selection.ClearContents

On Error GoTo ErrorHandler

ActiveWorkbook.Queries("tickets").Delete

ErrorHandler:
    ActiveWorkbook.Queries.Add Name:="tickets", Formula:= _
        "let" & Chr(13) & "" & Chr(10) & "    Source = Csv.Document(File.Contents(""C:\Users\***\Downloads\tickets.csv""),[Delimiter="","", Columns=5, Encoding=65001, QuoteStyle=QuoteStyle.None])," & Chr(13) & "" & Chr(10) & "    #""Changed Type"" = Table.TransformColumnTypes(Source,{{""Column1"", type datetime}, {""Column2"", type text}, {""Column3"", type text}, {""Column4"", type text}, {""Column5"", type text}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & "    " & _
        "#""Changed Type"""
    Worksheets("tickets").Select
    With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
        "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=tickets;Extended Properties=""""" _
        , Destination:=Range("$A$1")).QueryTable
        .CommandType = xlCmdSql
        .CommandText = Array("SELECT * FROM [tickets]")
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .ListObject.DisplayName = "tickets"
        .Refresh BackgroundQuery:=False
        Range("tickets[[#Headers],[Column1]]").Select
        ActiveCell.FormulaR1C1 = "Date"
        Range("tickets[[#Headers],[Column2]]").Select
        ActiveCell.FormulaR1C1 = "Case"
        Range("tickets[[#Headers],[Column3]]").Select
        ActiveCell.FormulaR1C1 = "Issue"
        Range("tickets[[#Headers],[Column4]]").Select
        ActiveCell.FormulaR1C1 = "Status"
        Cells.Select
        Range("tickets[[#Headers],[Issue]]").Activate
        ActiveSheet.ListObjects("tickets").ShowTableStyleRowStripes = False
        ActiveWindow.ScrollColumn = 2
        ActiveWindow.ScrollColumn = 1
        Range("A2").Select
    End With
    
    a = Worksheets("tickets").Cells(Rows.count, 1).End(xlUp).Row
    For i = 2 To a
    
        If InStr(Worksheets("tickets").Cells(i, 4).Value, "Following") Then
            Worksheets("tickets").Rows(i).Select
            With Selection.Interior
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
                .Color = RGB(170, 145, 135)
                .TintAndShade = 0
                .PatternTintAndShade = 0
            End With

        ElseIf InStr(Worksheets("tickets").Cells(i, 4).Value, "TR") Then
            Worksheets("tickets").Rows(i).Select
            With Selection.Interior
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
                .Color = RGB(70, 245, 235)
                .TintAndShade = 0
                .PatternTintAndShade = 0
            End With
        
        ElseIf InStr(Worksheets("tickets").Cells(i, 4).Value, "Provided feedback") Then
            Worksheets("tickets").Rows(i).Select
            With Selection.Interior
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
                .Color = RGB(25, 225, 92)
                .TintAndShade = 0
                .PatternTintAndShade = 0
            End With
        
        ElseIf InStr(Worksheets("tickets").Cells(i, 4).Value, "CSN") Then
            Worksheets("tickets").Rows(i).Select
            With Selection.Interior
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
                .Color = RGB(60, 40, 220)
                .TintAndShade = 0
                .PatternTintAndShade = 0
            End With
        
        ElseIf InStr(Worksheets("tickets").Cells(i, 4).Value, "Requested") Or InStr(Worksheets("tickets").Cells(i, 4).Value, "access") Then
            Worksheets("tickets").Rows(i).Select
            With Selection.Interior
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
                .Color = RGB(200, 250, 5)
                .TintAndShade = 0
                .PatternTintAndShade = 0
            End With

        End If
    Next
    
End Sub

First Run

Second Run

excel vba

Solution 1:^[1]

Compiled but untested. In addition to the issue addressed in the comments above, some suggestions for avoiding the select/activate and reducing the code volume.

Sub tix_import()
'
' tix_import Macro
'
    Dim ws As Worksheet, wb As Workbook, i As Long, v, clr As Long, rw As Range
    Dim lo As ListObject
    
    Set wb = ThisWorkbook
    Set ws = wb.Worksheets("tickets")
    
    ws.Select
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 1
    
    With ws.UsedRange
        .ClearContents
        .Interior.ColorIndex = xlNone  '<<<<<<<<<<< clear previous color
    End With
    
    On Error Resume Next
    wb.Queries("tickets").Delete
    On Error GoTo 0 'stop ignoring errors
    
    wb.Queries.Add Name:="tickets", Formula:= _
        "let" & vbCrLf & "    Source = Csv.Document(File.Contents(""C:\Users\***\Downloads\tickets.csv"")," & _
        "[Delimiter="","", Columns=5, Encoding=65001, QuoteStyle=QuoteStyle.None])," & vbCrLf & _
        "    #""Changed Type"" = Table.TransformColumnTypes(Source,{{""Column1"", type datetime}, " & _
        "    {""Column2"", type text}, {""Column3"", type text}, {""Column4"", type text}, " & _
        "    {""Column5"", type text}})" & vbCrLf & "in" & vbCrLf & "  #""Changed Type"""
    
    Set lo = ws.ListObjects.Add(SourceType:=0, Source:= _
        "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=tickets;Extended Properties=""""", _
        Destination:=ws.Range("$A$1"))
    
    With lo.QueryTable
        .CommandType = xlCmdSql
        .CommandText = Array("SELECT * FROM [tickets]")
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .ListObject.DisplayName = "tickets"
        .Refresh BackgroundQuery:=False
        .ShowTableStyleRowStripes = False
    End With
    
    ws.Range("tickets[[#Headers],[Column1]]").Value = "Date" 'no need for select
    ws.Range("tickets[[#Headers],[Column2]]").Value = "Case"
    ws.Range("tickets[[#Headers],[Column3]]").Value = "Issue"
    ws.Range("tickets[[#Headers],[Column4]]").Value = "Status"
    'loop over the rows in the querytable/listobject
    For Each rw In lo.DataBodyRange.Rows
    
        v = rw.Cells(i, 4).Value
        
        If InStr(v, "Following") Then
            clr = RGB(170, 145, 135)
        ElseIf InStr(v, "TR") Then
            clr = RGB(70, 245, 235)
        ElseIf InStr(v, "Provided feedback") Then
            clr = RGB(25, 225, 92)
        ElseIf InStr(v, "CSN") Then
            clr = RGB(60, 40, 220)
        ElseIf InStr(v, "Requested") Then
            clr = RGB(200, 250, 5)
        Else
            clr = -1
        End If
        
        If clr <> -1 Then rw.Interior.Color = clr 'apply color if any specified
    Next rw
    
End Sub

Sources

This article follows the attribution requirements of Stack Overflow and is licensed under CC BY-SA 3.0.

Source: Stack Overflow

Solution	Source
Solution 1	Tim Williams

'Loop to color row when string found

Solution 1:[1]

Sources

Related Questions

Solution 1:^[1]