ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Conditional borders (https://www.excelbanter.com/excel-programming/443986-conditional-borders.html)

Slim Slender[_3_]

Conditional borders
 
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[_2_]

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

Slim Slender[_3_]

Conditional borders
 
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[_2_]

Conditional borders
 

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.R ows.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"
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.


All times are GMT +1. The time now is 08:59 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com