Excel VBA loop/color row issue, 1st run is fine, 2nd run, the loop finds more than it should-CodePudding

I have a very strange issue with the following code below "InStr(Worksheets("tickets").Cells(i, 4).Value, "Provided feedback") Then". This works fine if ran the 1st time, upon the 2nd time, it will not only find it's search string and color the row as it should, but it also colors everything else that fit no criteria, the same color as if it was found. It's not found when I run it the 1st time, but when I run it again, it just colors all the others that wasn'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. This is what's so strange, because it works fine the 1st time. Any help would be greatly appreciated.

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

CodePudding user response：

Could you not use Conditional Formatting for this? It'd probably be easier.

CodePudding user response：

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