Conditional borders

[Slim Slender]

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

 

[Jim Cone]

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" <[email protected]>
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

 

[Slim Slender]

Jim,
Thanks for your reply. The endless loop problem is solved. However, I
cannot afford to clear all formatting because there is other
formatting in the table besides the thick borders. I have to be able
to remove and replace only the thick borders. Also, this code is
placing the borders across columns A thru G (7 columns, or 5 columns
from C) instead of just A thru C (total of 5 columns). Also, it is
affecting the header row. Can we make it start at row 2 and leave the
header row alone? Thanks again.

 

[Jim Cone]

Public Sub DrawBorders_R2()
Dim N As Long
Dim numRows As Long
Dim numStart As Long

numStart = 2 'Start row must be 2 or more.
numRows = ActiveSheet.UsedRange.Rows(ActiveSheet.UsedRange.Rows.Count).Row

Application.ScreenUpdating = False
Range(Cells(numStart - 1, 1), Cells(numRows, 5)).Borders.LineStyle = xlLineStyleNone
For N = numStart To numRows
If Cells(N, 3).Offset(1, 0).Value <> Cells(N, 3).Value Then
With Cells(N, 1).Resize(1, 5).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = 1
End With
End If
Next
Application.ScreenUpdating = True
End Sub

--
Jim Cone
Portland, Oregon USA
http://www.mediafire.com/PrimitiveSoftware

..
..
..

"Slim Slender" <[email protected]>
wrote in message
Jim,
Thanks for your reply. The endless loop problem is solved. However, I
cannot afford to clear all formatting because there is other
formatting in the table besides the thick borders. I have to be able
to remove and replace only the thick borders. Also, this code is
placing the borders across columns A thru G (7 columns, or 5 columns
from C) instead of just A thru C (total of 5 columns). Also, it is
affecting the header row. Can we make it start at row 2 and leave the
header row alone? Thanks again.