Sorting and color-coding based on variables

I have the following three macros all running in the same module. Each one is attached to its own button (3 buttons total). All three buttons take an average of 6-12 mins to run. As I am working on figuring out additional buttons that will check/review other criteria on the sheet, I am looking to improve this.

Could anyone help make these run quicker and/or look more elegant? I am still fairly new to VBA, so I am fairly sure there is a lot of redundancy in my code that is slowing it down and making it less elegant, I unfortunately don't know how to eliminate this. I've briefly explained the function of each code block below.

This first one removes existing color, then looks for any blanks, highlights them red, then for any " --Select--" cells in yellow. This is to make sure the sheet isn't missing info.

```
Sub ItemVal()
'Validation, Checks Sheet For Uncompleted Sections
Application.ScreenUpdating = False

'Clear Color
Dim Clear As Range
Set Clear = ThisWorkbook.Sheets(1).Range("A3:FU5002")
For Each Cell In Range("A3:FU5002")
Cell.Interior.ColorIndex = 0
Next Cell

'Blank Cells
Dim BlankCel As Range
Set BlankCel = ThisWorkbook.Sheets(1).Range("A3:FU5002")
For Each Cell In Range("A3:FU5002")
If Cell.Value = "" Then
Cell.Interior.ColorIndex = 3
End If
Next Cell

Dim ImagTemp As Range
Set ImagTemp = ThisWorkbook.Sheets(1).Range("A3:FU5002")
For Each Cell In Range("A3:FU5002")
If Cell.Value = "Please Complete Image Template" Then
Cell.Interior.ColorIndex = 6
End If
Next Cell

'Selection
Dim InOut As Range
Set InOut = ThisWorkbook.Sheets(1).Range("A3:FU5002")
For Each Cell In Range("A3:FU5002")
If Cell.Value = " --Select--" Then
Cell.Interior.ColorIndex = 6
End If
Next Cell

Dim YesNo As Range
Set YesNo = ThisWorkbook.Sheets(1).Range("A3:FU5002")
For Each Cell In Range("A3:FU5002")
If Cell.Value = " --Select Yes or No--" Then
Cell.Interior.ColorIndex = 6
End If
Next Cell

Dim SugLocLis As Range
Set

This is mainly looking at your first piece of code.

It is great that you are using Range variables and fully qualify them with the workbook and worksheet but you then do not use the variable. For, instance

Dim BlankCel As Range
Set BlankCel = ThisWorkbook.Sheets(1).Range("A3:FU5002")
For Each Cell In Range("A3:FU5002") ' change this line
    If Cell.Value = "" Then
        Cell.Interior.ColorIndex = 3
        End If
    Next Cell

You should replace the line marked with:

For Each Cell in BlankCel

Sometimes you can apply your action to the range in one go without having to loop. For example, Clear.Interior.ColorIndex = 0. You are also looping through the same range many times, each time testing for the value of the cell. Instead you should loop through the cells once and then test the value.

Sub ItemVal()

Dim Cell As Range
Dim rangeToTest As Range
Dim SugLocLis As Range

    'Validation, Checks Sheet For Uncompleted Sections
    Application.ScreenUpdating = False

    Set rangeToTest = ThisWorkbook.Sheets(1).Range("A3:FU5002")
    ' First, clear all the colours
    rangeToTest.Interior.ColorIndex = 0
    For Each Cell In rangeToTest.Cells
        Select Case Cell.Value
            Case ""
                Cell.Interior.ColorIndex = 3
            Case "Please Complete Image Template"
                Cell.Interior.ColorIndex = 6
            Case " --Select--"
                Cell.Interior.ColorIndex = 6
            Case " --Select Yes or No--"
                Cell.Interior.ColorIndex = 6
            Case Else
                ' Is there some default action to take?
        End Select
    Next Cell

    Set SugLocLis = ThisWorkbook.Sheets(1).Range("AM3:AM5002")
    For Each Cell In SugLocLis
        If Cell.Value = " --" Then
            Cell.Interior.ColorIndex = 6
        End If
    Next Cell

    Application.ScreenUpdating = True

End Sub

As an alternative, you could use the Range.Find method within a VBA function to return you just those that match the text you want. The Find method is pretty fast. Here is the function:

Public Function FindAllOccurrences(ByRef rangeToSearch As Range, ByRef textToFind As String, _
    Optional ByVal matchCaseOfText As Boolean = False, Optional ByVal matchCompleteText As Boolean = True) As Range

' returns a Range that contains all the cells in
' rangeToSearch that exactly match texToFind
' returns Nothing if no matches found
'
' Added parameters for matching case of text and matching complete text

Dim firstAddress As String
Dim cellFound As Range
Dim results As Range
Dim varLookAt As Variant

    If matchCompleteText Then
        varLookAt = xlWhole
    Else
        varLookAt = xlPart
    End If

    Set cellFound = rangeToSearch.Find(What:=textToFind, LookIn:=xlValues, LookAt:=varLookAt, MatchCase:=matchCaseOfText)
    If Not (cellFound Is Nothing) Then
        ' Have found textToFind at least once
        Set results = cellFound
        ' Store the address of the first result
        firstAddress = cellFound.Address
        Do
            Set cellFound = rangeToSearch.FindNext(After:=cellFound)
            If cellFound Is Nothing Then
                Exit Do
            Else
                ' Has the Find looped back to first cell?
                If cellFound.Address = firstAddress Then
                    Exit Do
                Else
                    Set results = Application.Union(results, cellFound)
                End If
            End If
        Loop
    End If

    Set FindAllOccurrences = results

End Function

And here is an example of using the function:

Sub ExampleCode()

Dim cellsFound As Range
Dim rangeToTest As Range

    Set rangeToTest = ThisWorkbook.Sheets(1).Range("A3:FU5002")

    Set cellsFound = FindAllOccurrences(rangeToTest, "Please Complete Image Template", True, True)
    ' If no matches are found, then cellsFound Is Nothing
    If Not (cellsFound Is Nothing) Then
        cellsFound.Interior.ColorIndex = 6
    End If

End Sub

StackExchange Code Review Q#93361, answer score: 6