VBA Code for borders to adjust height dynamically based on changing number of rows in data range

[bootj1234]

I am in need of assistance for VBA code that will allow me to add perimeter borders to select range of cells within a larger data table range, where the height of the left and right side perimeter boarders adjust dynamically according to number of rows working up from the bottom of the range.

For example:
1) The overall data table range is A11:R35.
2) The select range of cells within the data table to which I want to add thick black perimeter boarders is the left, top and right sides of L11:R35.
3) Then, the next time the data table is updated, if there are more or less rows of data within the overall data table range, the left and right side perimeter borders of what was L11:R35 dynamically grow or reduce their height based on the total number of rows from the new bottom row of the data table range.
4) The last row in the data table is recognized/defined by any cell or cells at the bottom of the dynamic range with data in it.

Thanks
-John

 

[Worf]

This example assumes you are using a real table:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim lo As ListObject, br As Range, v, cc%, col1%, coln%
Set br = [L11:R35]                                      ' base range
Set lo = Me.ListObjects(1)                              ' the table
If Not Intersect(lo.Range, Target) Is Nothing Then
    col1 = br.Columns(1).Column
    cc = br.Columns.Count
    coln = br.Columns(cc).Column
    Range(Cells(1, col1), Cells(Rows.Count, col1)).Borders(7).LineStyle = xlNone   ' left
    Range(Cells(1, coln), Cells(Rows.Count, coln)).Borders(10).LineStyle = xlNone  ' right
    v = Split(lo.Range.Address, "$")
    With Range(br.Cells(1, 1), Cells(v(4), col1)).Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThick
    End With
    With Range(br.Cells(1, cc), Cells(v(4), coln)).Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThick
    End With
End If
End Sub

 

[bootj1234]

Hi Worf - Thank you for providing the above code. When I place the code into a new module I can't see it in my list of Macros in order to make it run. I don't know for sure, but I think it may have something to do with it being a Private Sub Worksheet vs. Public. Also, I get a compiling error with the use of
Set lo = Me.ListObjects(1)

Your suggestions of how I can make the your code run from my list of macros would be greatly appreciated.

Thanks - John

 

[Worf]

Hi John

Place the code on that sheet’s module, not a standard module. It will run automatically if the table changes.
Note that it assumes a table created at Ribbon>Insert>Table.

 

[bootj1234]

Hi Worf,

What VBA Code would I use if the table were not created using Ribbon>Insert>Table?

Thanks - John

 

[Worf]

Something like this; I tested it inserting or deleting one row at a time.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim br As Range, v, cc%, col1%, coln%, lr%, lo As Range
Set br = [L11:R35]
lr = [a:r].Find("*", [a1], xlValues, xlPart, xlByRows, xlPrevious, 0).Row
Set lo = Range("a11:r" & lr)
If Not Intersect(lo, Target) Is Nothing Or Target.Row - lr = 1 Then
    col1 = br.Columns(1).Column
    cc = br.Columns.count
    coln = br.Columns(cc).Column
    Range(Cells(1, col1), Cells(Rows.count, col1)).Borders(7).LineStyle = xlNone   ' left
    Range(Cells(1, coln), Cells(Rows.count, coln)).Borders(10).LineStyle = xlNone  ' right
    v = Split(lo.Address, "$")
    With Range(br.Cells(1, 1), Cells(v(4), col1)).Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThick
    End With
    With Range(br.Cells(1, cc), Cells(v(4), coln)).Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThick
    End With
End If
End Sub

 

[bootj1234]

Hi Worf – Thanks for all the assistance you’ve been providing me with my border formatting request. The code you sent me last night is doing the trick, with the exception of what I hope is a minor fix to your existing code, which I need your assistance in making. Here’s the situation: The data table I am using varies in its number of rows each time I copy and paste it in from another worksheet before formatting. The starting location where I paste the data table is always the same location and range width, A:11 through R:11. Where I need your assistance in revising the code is to allow for the overall height of all the vertical borders to change based on the last row in the data table - as is recognized/defined by any cell or cells at the bottom of the last row of the table range. That said, I need the code to recognize and adjust the formatting of all vertical borders heights based on the changing row count every time I paste the table in and run the border formatting macro. Is this something you can do?

Again, thanks for all your assistance!
-John

 

[Worf]

This version adjusts all row heights based on the last row:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim br As Range, v, cc%, col1%, coln%, lr%, lo As Range, rn%
Set br = [L11:R35]
lr = [a:r].Find("*", [a1], xlValues, xlPart, xlByRows, xlPrevious, 0).Row
Set lo = Range("a11:r" & lr)
If Not Intersect(lo, Target) Is Nothing Or Target.Row - lr = 1 Then
    If Target.Row - lr = 1 Then
        rn = Target.Row - 1
    Else
        rn = Target.Row
    End If
    col1 = br.Columns(1).Column
    cc = br.Columns.count
    coln = br.Columns(cc).Column
    Range(Cells(1, col1), Cells(Rows.count, col1)).Borders(7).LineStyle = xlNone   ' left
    Range(Cells(1, coln), Cells(Rows.count, coln)).Borders(10).LineStyle = xlNone  ' right
    v = Split(lo.Address, "$")
    With Range(br.Cells(1, 1), Cells(v(4), col1)).Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThick
    End With
    With Range(br.Cells(1, cc), Cells(v(4), coln)).Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThick
    End With
    Rows(br.Cells(1, 1).Row & ":" & rn).RowHeight = Rows(rn & ":" & rn).RowHeight
End If
End Sub

 

[bootj1234]

Hi Wolf - I have one more favor to ask you about modifying the code you provided me for dynamically adding boarders to a range: What would the code modification changes need to be for placing the code in to a module so that I can run the macro whenever I wanted using the Run Macro menu button?

Thanks for the assistance - John

 

[Worf]

Hi John

This version works on the active sheet and replaces the changed cell from the previous code with the active cell.

Sub Wksheet_Change()
Dim br As Range, v, cc%, col1%, coln%, lr%, lo As Range, rn%, target As Range
Set br = [L11:R35]
Set target = ActiveCell
lr = [a:r].Find("*", [a1], xlValues, xlPart, xlByRows, xlPrevious, 0).Row
Set lo = Range("a11:r" & lr)
If Not Intersect(lo, target) Is Nothing Or target.Row - lr = 1 Then
    If target.Row - lr = 1 Then
        rn = target.Row - 1
    Else
        rn = target.Row
    End If
    col1 = br.Columns(1).Column
    cc = br.Columns.Count
    coln = br.Columns(cc).Column
    Range(Cells(1, col1), Cells(Rows.Count, col1)).Borders(7).LineStyle = xlNone   ' left
    Range(Cells(1, coln), Cells(Rows.Count, coln)).Borders(10).LineStyle = xlNone  ' right
    v = Split(lo.Address, "$")
    With Range(br.Cells(1, 1), Cells(v(4), col1)).Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThick
    End With
    With Range(br.Cells(1, cc), Cells(v(4), coln)).Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThick
    End With
    Rows(br.Cells(1, 1).Row & ":" & rn).RowHeight = Rows(rn & ":" & rn).RowHeight
End If
End Sub<strike></strike>