Search code examples
vbaexcelnamed-ranges

Loop through all Cells in a Row and a Named Range Simultaneously


Apologies up front, I'm a VBA novice.

I'm looking to to find a way where I can loop through all cells in a row and if the cell is a part of a named range "Targets", I have the background colour change.

I have originally done this using the code below where I would check all cells in the named range but it is becoming so slow it's not practical. I was hoping to speed the macro up by restricting the function to only the active row.

I have tried various versions of Intersect and whilst I get it to select the cells I want to look at, I'm struggling to be able to use the result.

Dim cell As Range
For Each cell In Sheet5.Range("Targets")
    'Blank cells
    If Cells(cell.Row, "JE").Value = "" Then
        cell.Interior.Color = xlNone
        cell.Font.Bold = False
        cell.Font.Color = vbBlack
    ElseIf cell.Value = "" And Month(Cells(cell.Row, "").Value) Mod 2 = 0 Then 'Odd
        cell.Interior.Color = RGB(221, 221, 221)
        cell.Font.Bold = False
        cell.Font.Color = vbBlack
    ElseIf cell.Value = "" And Month(Cells(cell.Row, "").Value) Mod 2 = 1 Then  'Even
        cell.Interior.Color = xlNone
        cell.Font.Bold = False
        cell.Font.Color = vbBlack
    '1-5 days Early (Green)
    ElseIf cell.Offset(0, 1).Value = "" And cell.Value >= Application.WorksheetFunction.WorkDay(Date, 1, [Support!B4:B100]) And cell.Value <= Application.WorksheetFunction.WorkDay(Date, 5, [Support!B4:B100]) Then
        cell.Interior.Color = RGB(188, 253, 175)
        cell.Font.Bold = True
        cell.Font.Color = RGB(84, 130, 53)
    '1-3 Days Overdue (Orange)
    ElseIf cell.Offset(0, 1).Value = "" And cell.Value <= Application.WorksheetFunction.WorkDay(Date, -1, [Support!B4:B100]) And cell.Value >= Application.WorksheetFunction.WorkDay(Date, -3, [Support!B4:B100]) Then
        cell.Interior.Color = RGB(255, 168, 39)
        cell.Font.Bold = True
        cell.Font.Color = vbWhite
    '1-3 Days Overdue (Red)
    ElseIf cell.Offset(0, 1).Value = "" And cell.Value < Application.WorksheetFunction.WorkDay(Date, -3, [Support!B4:B100]) Then
        cell.Interior.Color = RGB(158, 0, 0)
        cell.Font.Bold = True
        cell.Font.Color = vbWhite
    'Today (Blue)
    ElseIf cell.Offset(0, 1).Value = "" And cell.Value = Application.WorksheetFunction.WorkDay(Date, 0, [Support!B4:B100]) Then
        cell.Interior.Color = RGB(4, 119, 224)
        cell.Font.Bold = True
        cell.Font.Color = vbWhite
    ElseIf Month(Cells(cell.Row, "").Value) Mod 2 = 0 Then 'Odd
        cell.Interior.Color = RGB(221, 221, 221)
        cell.Font.Bold = False
        cell.Font.Color = vbBlack
    Else: Month (Cells(cell.Row, "").Value) Mod 2 = 1 'Even
        cell.Interior.Color = xlNone
        cell.Font.Bold = False
        cell.Font.Color = vbBlack
    End If
Next

Solution

  • To check if a range is within another range you can use the Application.Intersect Method.

    Here is an example that checks if A1 is in the NamedRange:

    If Not Intersect(Range("A1"), Range("NamedRange")) Is Nothing Then
        'A1 is in NamedRange
    Else
        'A1 is not it NamedRange
    End If