View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
Jim Cone[_2_] Jim Cone[_2_] is offline
external usenet poster
 
Posts: 1,549
Default Conditional borders

One way that is not too far removed from your way.
There are other ways...
'---
Public Sub DrawBorders_R1()
Dim cell As Range
Dim numRows As Long
Dim rngSelected As Range

Set rngSelected = Application.Intersect(ActiveSheet.Range("C:C"), _
ActiveSheet.UsedRange)
numRows = rngSelected(rngSelected.Rows.Count).Row
Set cell = rngSelected(1, 1)
rngSelected.Resize(, 5).ClearFormats '<<< All formatting removed

Do
If cell.Offset(1, 0).Value < cell.Value Then
With cell.Resize(1, 5).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = 1
End With
End If
Set cell = cell(2, 1)
Loop Until cell.Row = numRows
End Sub
'---

Jim Cone
Portland, Oregon USA
http://www.contextures.com/excel-sort-addin.html

..
..
..

"Slim Slender"
wrote in message
...
The following procedure places borders conditionally as I want but it
does not stop when the Until condition is met. Instead it continues,
apparently to the bottom of the sheet, then gives an Error 400 which
is no help.
I think the problem is Range("C:C") but I don't know how to fix it.
Also, I would like to precede this in the same procedure with
something that would remove any existing borders. Any help would be
appreciated.

Public Sub DrawBorders()
Dim cell As Range
Dim numRows As Single
numRows = Selection.CurrentRegion.Rows.Count
Do
For Each cell In Range("C:C")
If cell.Offset(1, 0).Value < cell.Value Then
With Range(Cells(cell.Row, 1), Cells(cell.Row, 5)).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = 1
End With
Else
End If
Next cell
Loop Until cell.Row = numRows
End Sub