VBA: Drawing Borders (Tidy-up Code)

[dr_drews]

Hi,

Does anyone know a good way to tidy-up the following code. I am trying to draw borders around various different ranges, but as I'm doing this on about 15 different ranges the code takes up a lot of space (and probably isn't very efficient). This is a sample of what I have at the moment:

With .Range(Cells(4, "D"), Cells(Counter, "D"))
.Borders(xlEdgeBottom).Weight = xlMedium
.Borders(xlEdgeTop).Weight = xlMedium
.Borders(xlEdgeLeft).Weight = xlMedium
.Borders(xlEdgeRight).Weight = xlMedium
End With
With .Range(Cells(4, "F"), Cells(Counter, "F"))
.Borders(xlEdgeBottom).Weight = xlMedium
.Borders(xlEdgeTop).Weight = xlMedium
.Borders(xlEdgeLeft).Weight = xlMedium
.Borders(xlEdgeRight).Weight = xlMedium
End With
With .Range(Cells(4, "G"), Cells(Counter, "G"))
.Borders(xlEdgeBottom).Weight = xlMedium
.Borders(xlEdgeTop).Weight = xlMedium
.Borders(xlEdgeLeft).Weight = xlMedium
.Borders(xlEdgeRight).Weight = xlMedium
End With

 

[stilesbn]

Just make your range the whole thing at once.

With .Range(Cells(4, "D"), Cells(Counter, "G"))
.Borders(xlEdgeBottom).Weight = xlMedium
.Borders(xlEdgeTop).Weight = xlMedium
.Borders(xlEdgeLeft).Weight = xlMedium
.Borders(xlEdgeRight).Weight = xlMedium
End With

 

[dr_drews]

That helps, thanks. Means I'd end up with this as I don't want to border certain ranges (column I for example). Is this the tidiest it can be?

With .Range(Cells(4, "D"), Cells(Counter, "H"))
.Borders(xlEdgeBottom).Weight = xlMedium
.Borders(xlEdgeTop).Weight = xlMedium
.Borders(xlEdgeLeft).Weight = xlMedium
.Borders(xlEdgeRight).Weight = xlMedium
End With
With .Range(Cells(4, "J"), Cells(Counter, "O"))
.Borders(xlEdgeBottom).Weight = xlMedium
.Borders(xlEdgeTop).Weight = xlMedium
.Borders(xlEdgeLeft).Weight = xlMedium
.Borders(xlEdgeRight).Weight = xlMedium
End With
With .Range(Cells(Counter, "A"), Cells(Counter, "H"))
.Borders(xlEdgeBottom).Weight = xlMedium
.Borders(xlEdgeTop).Weight = xlMedium
.Borders(xlEdgeLeft).Weight = xlMedium
.Borders(xlEdgeRight).Weight = xlMedium
End With
With .Range(Cells(Counter, "J"), Cells(Counter, "O"))
.Borders(xlEdgeBottom).Weight = xlMedium
.Borders(xlEdgeTop).Weight = xlMedium
.Borders(xlEdgeLeft).Weight = xlMedium
.Borders(xlEdgeRight).Weight = xlMedium
End With

 

[dr_drews]

Sorry, should have tested that first. It doesn't actually work as it just draws the border round the outside of the whole range, but I need to border all the columns within that range.

 

[stilesbn]

Sorry, should have tested that first. It doesn't actually work as it just draws the border round the outside of the whole range, but I need to border all the columns within that range.

Add

.Borders (xlInsideVertical).Weight = xlMedium

and possibly

.Borders (xlInsideHorizontal).Weight = xlMedium

Depending on what you want.

 

[mvptomlinson]

If there was some kind of pattern to your rows and columns that needed borders, you could use a loop, similar to the one shown below. You would create an array of the column letters you want borders around (adjust the array size to the correct number of elements, then specify the elements as shown). Not sure based on your example code that you could get to something like this though.

Sub drews()
Dim counter As Long, arr(1 To 3) As String
arr(1) = "D": arr(2) = "F": arr(3) = "G"
counter = 2  ' Just for testing purposes

For i = 1 To UBound(arr)
    With Range(Cells(4, arr(i)), Cells(counter, arr(i)))
        .Borders(xlEdgeBottom).Weight = xlMedium
        .Borders(xlEdgeTop).Weight = xlMedium
        .Borders(xlEdgeLeft).Weight = xlMedium
        .Borders(xlEdgeRight).Weight = xlMedium
    End With
Next i
End Sub

 

[dr_drews]

Arrays work perfectly.

Thanks all.