VBA Add Borders to every column of Dynamic Selected Area

[AlexB123]

Hi all,

For every work assignment in Excel I have a specific format for presenting data. I add outside borders to the headings and to each column in a selected area. Sometimes it is just one "table" (I don't actually create an excel table, I just add formatting to raw data), and other times I have multiple "tables" on a single sheet. Because I have to make many edits and resubmit the assignment multiple times, I am trying to create a code that will do this formatting automatically and regardless of whether it is one or several "tables" on a sheet.

My approach is to first find the (dynamic) range, then loop through every column in the selection and apply the formatting. So far I can get vertical borders on each column, but my bottom borders are at the "bottom" limits of the excel rows.

For example, I want
_______________________
|A1|B1|C1|D1|E1|F1|G1|H1|
| | | | | | | | | | | | | | | | | |
| | | | | | | | | | | | | | | | | |
| | | | | | | | | | | | | | | | | |
________________________

instead of
_______________________
|A1|B1|C1|D1|E1|F1|G1|H1|
| | | | | | | | | | | | | | | | | |
| | | | | | | | | | | | | | | | | |
| | | | | | | | | | | | | | | | | |


Here is the code I have so far (note that I have commented out previous code that didn't quite work):

Sub COMPARISON_BUILD_TABLE_CODE()
'
' COMPARISON_BUILD_TABLE_CODE Macro
'


' LOOP THROUGH EACH COLUMN AND APPLY BORDERS
    
    'Dim myRng As Range
    Dim rng As Range
    
    Dim rng1 As Range
    Dim rng2 As Range
    Dim rng3 As Range
    
    'Dim Last_Column As Integer
    'Dim Last_Row As Long
    
    'Refresh Used Range
    'Set myRng = Worksheets("Top_10_DIAGS").UsedRange
    'Select UsedRange
    'myRng.Select
    'Worksheets("Top_10_DIAGS").UsedRange.Select
           
    'Last_Column = 0
    'Last_Column = wsheet.Cells.Find("*", [a1], , , xlByColumns, xlPrevious).Column
    'Last_Row = wsheet.Cells.Find("*", [a1], , , xlByRows, xlPrevious).Row
    'wsheet.Range(Cells(1, 1), Cells(Last_Row, Last_Column)).NumberFormat = "@" 'standard text formatting
     
    
    
    Dim wsheet As Worksheet
    
    Dim i As Long
    
    Worksheets("Top_10_DIAGS").Activate
    Set wsheet = ActiveSheet
     
                'code to find range
                Set rng1 = Cells.Find("*", , , , xlByRows, xlPrevious)
                Set rng2 = Cells.Find("*", , , , xlByColumns, xlPrevious)
                If Not rng1 Is Nothing Then
                    Set rng3 = Range(ActiveCell, Cells(rng1.Row, rng2.Column))
                    MsgBox "Range is " & rng3.Address(0, 0)
                    'if you need to actual select the range (which is rare in VBA)
                    Application.Goto rng3
                Else
                    MsgBox "sheet is blank", vbCritical
                End If
    
        
            
                                                                    'line below was "For Each rng In Range(A1, Cells(Last_Row, Last_Column)).Columns"
            'For Each rng In Range(a1, Cells(Last_Row, Last_Column)).Columns                                                            'For Each rng In myRng.Columns
            'For Each rng2 In rng3.Columns
            For i = 1 To Selection.Columns.Count
            Columns(i).Select
            Selection.Borders(xlDiagonalDown).LineStyle = xlNone
            Selection.Borders(xlDiagonalUp).LineStyle = xlNone
            With Selection.Borders(xlEdgeLeft)
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlThin
            End With
            With Selection.Borders(xlEdgeTop)
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlThin
            End With
            With Selection.Borders(xlEdgeBottom)
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlThin
            End With
            With Selection.Borders(xlEdgeRight)
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlThin
            End With
            Selection.Borders(xlInsideVertical).LineStyle = xlNone
            Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Next i
    
    
End Sub

Thanks for any help!

 

[Alan_P]

Hi AlexB,

The below should work for 1 table (Note - Last row is taken from column A, Last column is taken from row 1)

If you have multiple tables, what is separating them? Will they be stacked vertically or horizontally?

Sub Blah()

'Find last used column in row 1
LastCol = Cells(1, Columns.Count).End(xlToLeft).Column
'Find last used row in olumn A
LastRw = Range("A" & Rows.Count).End(xlUp).Row

'with A1:BottomRight
With Range(Cells(1, 1), Cells(LastRw, LastCol))

    'clear all current borders
    .Borders.LineStyle = xlNone

    With .Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With
    With .Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With
    With .Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With
    
    'format the range
    .NumberFormat = "@"
    
End With

'add all borders to top row
With Range(Cells(1, 1), Cells(1, LastCol)).Borders
    .LineStyle = xlContinuous
    .Weight = xlMedium
End With

'add bottom border to last row
With Range(Cells(LastRw, 1), Cells(LastRw, LastCol)).Borders(xlEdgeBottom)
    .LineStyle = xlContinuous
    .Weight = xlMedium
End With
 
End Sub

Hope this helps,
Cheers,
Alan.

 

[AlexB123]

Thanks Alan,

Your code pretty much worked for my current assignment. I had tried to use the End(xltoleft).Column and End(xlup).Row statements in a similar manner, but I started experiencing problems because sometimes my data will have blank cells throughout. Also, I would like to develop VBA that will work anywhere on the sheet ... do you think I could replace "cells(1, ... )" with something like "cells(ActiveCell, ...)"?

In my current assignment, I have three tables at the top of the sheet (horizontally stacked) but only separated by a single, empty column of cells ... so you're code worked. Generally, if I have any more than that, I will stack the same amount vertically.

I.e.,
X1 Y1 Z1
X2 Y2 Z2
X3 Y3 Z3

and so on.

The most confusing piece of all this, for me, is attempting to use dynamic ranges without the end(xl...).column/row statements. Thanks!