Comparing dates from sheets

I am looking to increase the speed of this Excel VBA Nested Loop. The loop compares dates from one sheet to a secondary sheet. If they match, I change the border around the cell to highlight it. It currently works fine, but takes about 30 seconds to process per sub. Is there a way to implement an array or other tactic to speed it up?

Sub Single()

Dim DateRng As Range, DateCell As Range, DateRngPay As Range
Dim cellA As Range
Dim cellB As Range
Dim myColor As Variant

Set DateRng = ActiveWorkbook.Worksheets("SS").Range("B11:F16,I11:M16,P11:t16,B19:F24,I19:M24,P19:t24,B27:F32,I27:M32,P27:t32,B35:F40,I35:M40,P35:t40")
Set DateRngPay = ActiveWorkbook.Worksheets("PS").Range("C2:C67")
myColor = Array("38")

If ActiveWorkbook.Worksheets("Info").Range("B67") = 1 Then
    With DateRng
            .Interior.ColorIndex = xlColorIndexNone
            .Borders.ColorIndex = 1
            .Borders.Weight = xlHairline
    For Each cellA In DateRng
        For Each cellB In DateRngPay
                If cellB.Value > "" And cellA.Value > "" And cellB.Value = cellA.Value Then
                With cellA.Borders
                    .ColorIndex = myColor
                    .Weight = xlMedium
                End With
                Exit For
            End If
        Next cellB
    Next cellA
    End With
End If
End Sub

Normally I'd go on and ramble about how your procedure's name should start with a verb, how the casing of your local variables isn't consistently camelCase, how the procedure is implicitly Public, how the indentation is broken and therefore confusing here:

With DateRng
        .Interior.ColorIndex = xlColorIndexNone
        .Borders.ColorIndex = 1
        .Borders.Weight = xlHairline
For Each cellA In DateRng
    For Each cellB In DateRngPay
            If cellB.Value > "" And cellA.Value > "" And cellB.Value = cellA.Value Then
            With cellA.Borders
                .ColorIndex = myColor
                .Weight = xlMedium
            End With
            Exit For
        End If
    Next cellB
Next cellA
End With

Compare to:

With DateRng
    .Interior.ColorIndex = xlColorIndexNone
    .Borders.ColorIndex = 1
    .Borders.Weight = xlHairline
    For Each cellA In DateRng
        For Each cellB In DateRngPay
            If cellB.Value > "" And cellA.Value > "" And cellB.Value = cellA.Value Then
                With cellA.Borders
                    .ColorIndex = myColor
                    .Weight = xlMedium
                End With
                Exit For
            End If
        Next cellB
    Next cellA
End With

...I'd also so mention that I find cellB.Value > "" a little weird when everyone else would have written cellB.Value <> "" or perhaps cellB.Value <> vbNullString.

I might even have wrecked my brains around trying to find a way to remove the need for a nested loop at all.

All of that would have been useful advice... but there's an even better one.

Ready?

Unless you have a VERY specific and cast-in-stone requirement for the border width, there's no need for any VBA code to do this.

First, name the range on SS!$C$2:$C$67, say MyValues - here I've populated the data with values 1-66, but anything will do:

On the PS sheet, select cell PS!$B$11 and create a conditional format for it, using this formula:

=AND(Info!$B$67=1,NOT(ISNA(MATCH(B11,MyValues,0))))

Decide how you want the conditional format to look like, and then change the applies to range to the cells you're interested in:

=$B$11:$F$16,$I$11:$M$16,$P$11:$T$16,$P$19:$T$24,$I$19:$M$24,$B$19:$F$24,$B$27:$F$32,$I$27:$M$32,$P$27:$T$32

I've shaded these target cells on my own sheet here, but as you can see, any value in these cells that's present on MyValues gets a yellow background and a black border...

...instantaneously.

StackExchange Code Review Q#140973, answer score: 3