On Sunday, January 26, 2014 2:50:00 AM UTC-8, Claus Busch wrote:
Hi Howard,



I tested a bit more to make the code easier and more readable. That is

the result:



Sub TestCB()

Dim myRng As Range

Dim rngC As Range

Dim myR As Long

Dim i As Long



With Sheets("BLANK")

myR = WorksheetFunction.Match(.Range("Y1"), _

.Range(.Range("X1") & "DeskRng"), 0)



Set myRng = .Range(.Range("X1")).Rows(myR)

'MsgBox myRng.Address

End With



For i = 1 To myRng.Cells.Count

If myRng.Cells(i).Interior.Pattern = xlNone Then

With myRng.Cells(i)

With .Borders(xlEdgeLeft)

.LineStyle = xlContinuous

.ColorIndex = xlAutomatic

.Weight = IIf(Not WorksheetFunction.IsOdd(i), _

xlHairline, xlThin)

End With

With .Borders(xlEdgeTop)

.LineStyle = xlContinuous

.ColorIndex = xlAutomatic

.Weight = xlThin

End With

With .Borders(xlEdgeBottom)

.LineStyle = xlContinuous

.ColorIndex = xlAutomatic

.Weight = xlThin

End With

With .Borders(xlEdgeRight)

.LineStyle = xlContinuous

.ColorIndex = xlAutomatic

.Weight = IIf(WorksheetFunction.IsOdd(i), _

xlHairline, xlThin)

End With

End With

End If

Next i



With Sheets("BLANK")

.Range(.Range("X1")).BorderAround _

ColorIndex:=xlAutomatic, Weight:=xlMedium

End With

End Sub



No more test for column C or Z and no seperate loops for these columns.



Please check the interior color into the ranges. I guess some cells are

white instead of no color.





Regards

Claus B.

--


With this code and the enlarged ranges for Desk and Day I have Monday working perfectly.

Just a matter of adjusting the other days to match.

I appreciate your help, you make it look sooo easy.

Howard