Comments on: Borders All Around

By: Andrew

Andrew — Thu, 06 Dec 2007 07:57:00 +0000

I came up with something similar to Andy. Not as well done though.

Sub AddMultipleSelectionBorders()
On Error Resume Next 'In case cells have no offset cells
Dim rCell As Range

If Not TypeName(Selection) = "Range" Then Exit Sub

For Each rCell In Selection

If Intersect(rCell.Offset(-1), Selection) Is Nothing Then
rCell.Borders(xlEdgeTop).LineStyle = xlContinuous
End If

If Intersect(rCell.Offset(1), Selection) Is Nothing Then
rCell.Borders(xlEdgeBottom).LineStyle = xlContinuous
End If

If Intersect(rCell.Offset(, -1), Selection) Is Nothing Then
rCell.Borders(xlEdgeLeft).LineStyle = xlContinuous
End If

If Intersect(rCell.Offset(, 1), Selection) Is Nothing Then
rCell.Borders(xlEdgeRight).LineStyle = xlContinuous
End If

Next rCell

On Error Goto 0
End Sub

By: fzz

fzz — Tue, 04 Dec 2007 22:26:00 +0000

And my approach – put borders around all areas, then remove the unnecessary ones.

Sub test()

Dim c As Range, s As Range

Dim nc As Long, nr As Long

If TypeOf Selection Is Range Then Set s = Selection _

Else Exit Sub

nc = s.Parent.Cells.Columns.Count

nr = s.Parent.Cells.Rows.Count

s.BorderAround LineStyle:=xlContinuous, Weight:=xlThin

For Each c In s

If c.Row > 1 Then _

If Not Intersect(c.Offset(-1, 0), s) Is Nothing Then _

c.Borders(xlEdgeTop).LineStyle = xlLineStyleNone

If c.Row 1 Then _

If Not Intersect(c.Offset(0, -1), s) Is Nothing Then _

c.Borders(xlEdgeLeft).LineStyle = xlLineStyleNone

If c.Column

By: Zach

Zach — Tue, 04 Dec 2007 20:55:00 +0000

My take would never be described as elegant, but it does have the advantage that I'll be able to figure out how it works without having to think too much. It hurts sometimes.

Sub bar()
Dim r As Range
Dim r2 As Range
Dim btop As Boolean
Dim bbottom As Boolean
Dim bleft As Boolean
Dim bright As Boolean

on error resume next
For Each r In Selection.Cells
btop = True
bbottom = True
bleft = True
bright = True
For Each r2 In Selection.Cells
If r2.Address = r.Offset(-1, 0).Address Then btop = False
If r2.Address = r.Offset(1, 0).Address Then bbottom = False
If r2.Address = r.Offset(0, -1).Address Then bleft = False
If r2.Address = r.Offset(0, 1).Address Then bright = False
Next
If btop Then r.Borders(xlEdgeTop).LineStyle = xlContinuous
If btop Then r.Borders(xlEdgeTop).Weight = xlThin
If bbottom Then r.Borders(xlEdgeBottom).LineStyle = xlContinuous
If bbottom Then r.Borders(xlEdgeBottom).Weight = xlThin
If bright Then r.Borders(xlEdgeRight).LineStyle = xlContinuous
If bright Then r.Borders(xlEdgeRight).Weight = xlThin
If bleft Then r.Borders(xlEdgeLeft).LineStyle = xlContinuous
If bleft Then r.Borders(xlEdgeLeft).Weight = xlThin
Next
End Sub

By: Mike

Mike — Tue, 04 Dec 2007 17:39:00 +0000

i had problems with the original macro getting stuck at:

Dim tResult As CommonBorder

andy pope's worked just fine... however, where in the macro is the line style stated (or, how do i change to a thicker line)

thanks

Mike

By: Jon Peltier

Jon Peltier — Tue, 04 Dec 2007 17:01:00 +0000

I was going to suggest checking the intersection of the selected range and the cell on the other side of an area’s edge, then I see that’s what Andy has done. Very elegantly as usual.

By: Andy Pope

Andy Pope — Tue, 04 Dec 2007 15:50:00 +0000

This does each cell in turn so could be slow for very large selections.

Sub BorderAllAroundSelection()

Dim rngToBorder As Range
Dim rngCell As Range
Dim rngTest As Range
Dim lngBorderItem As Long
Dim vntOffsetRows As Variant
Dim vntOffsetCols As Variant

If Not TypeName(Selection) = "Range" Then Exit Sub

vntOffsetRows = Array(0, -1, 1, 0)
vntOffsetCols = Array(-1, 0, 0, 1)

Set rngToBorder = Selection

On Error Resume Next
For Each rngCell In rngToBorder
For lngBorderItem = 0 To 3
Set rngTest = rngCell.Offset(vntOffsetRows(lngBorderItem), vntOffsetCols(lngBorderItem))
If Not rngTest Is Nothing Then
If Intersect(rngTest, rngToBorder) Is Nothing Then
rngCell.Borders(lngBorderItem + 7).LineStyle = xlContinuous
End If
End If
Next
Next

End Sub

By: d Lee

d Lee — Tue, 04 Dec 2007 15:47:00 +0000

woops i was wrong; u'd need 3. (1) cell cell above AND cell left -> draw top and left border (2) cell cell above -> draw top border (3) cell cell left -> draw left border.

clearly this works for certain values only; but updates live very nicely. using would have the effect of boxing values together. should be trivial to make it box values near enough (but "nearness" would not be cumulative; nearness would only be vs immediate neighbours.

By: d Lee

d Lee — Tue, 04 Dec 2007 15:33:00 +0000

using conditional formatting u’d probably only need 2 conditions, not 4; i’m thinking 1 condition for a top border and 1 condition for a left border…