Automatically put borders around my data using VBA

M

Mister H

Well-known Member
Joined
Mar 6, 2002
Messages
1,507
Hi All:

I am working on a spreadsheet and I need to come up with a method of automatically placing border around my data. I only want borders if there is data in the Column A starting in cell A2

I need the borders to extend as far as there is data in Row 2. Ok I am getting confused just writing this :) Lol

Currently my data that I want bordered starts in cell A2 and goes down to A45 I then have data (peoples names) in Row 2 that currently extends to Column L. So at the moment I am wanting the borders to around A2 to L45

If I could I would want double lines around the entire area, thin solid lines vertically and thin dasked line horizonatally. The specific border is not the big thing it is mainly the ability to put borders around my data. What I want to do is be able to have people add to the spreadsheet but have the borders automated. So if someone adds 10 more categories in Column A and 4 names in Row 2 then the macro will need to put borders around my new data area which will be A2 to P55.

HOPEFULLY someone is following this. I think I need a beer :)

THANKS,
Mark
 

Excel Facts

What is =ROMAN(40) in Excel?
The Roman numeral for 40 is XL. Bill "MrExcel" Jelen's 40th book was called MrExcel XL.
Sort by date Sort by votes
Hmmmmmm :)

OK I found this code which easily takes care of putting borders in Column A (A2 to A45) but I need to expand it to the last cell in Row 2 that contains data (in this case currently Column L)

Code: 
Sub BorderMe_again()
    Dim c As Range
    For Each c In Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)
    Next
End Sub

Now I found this line of code that will identify L2 as my last cell containing data:

Code: 
LastCol = .Cells(2, .Columns.Count).End(xlToLeft).Column

How can I combine them? Any ideas or redirect would be greatly appreciated.

THANKS,
Mark :)
 
Upvote 0
Hi Mark,

Try the following code - this should be put under the worksheet code window of the worksheet you wish to add the borders to:

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)

    '//Define variables
    Dim LastRow As Integer      'variable to hold last row of data in column A
    Dim LastCol As Integer        'variable to hold last column of data (assuming row 1 contains headers)
    
    '//Only proceed if cell changed is in column A and row 2 onwards
    If Target.Column > 1 Or Target.Row = 1 Then Exit Sub
    
    '//Get the last row and column of data and assign to variable
    LastRow = Worksheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
    LastCol = Worksheets("Sheet1").Cells(1, Columns.Count).End(xlToLeft).Column
       
    '//Remove any existing borders that might exist
    Worksheets("Sheet1").Range("A2:AA65000").Select         '//Change the cell range to suit
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    
    '//If the LastRow variable is 1 then only the header row exists, therefore no formatting required, so stop execution
    If LastRow = 1 Then Exit Sub
    
    '//Set the cell range to add borders to
    Worksheets("Sheet1").Range(Cells(2, 1), Cells(LastRow, LastCol)).Select
    
    '//Set the left border (double solid line)
    Selection.Borders(xlEdgeLeft).LineStyle = xlDouble
    
    '//Set the top border (double solid line)
    Selection.Borders(xlEdgeTop).LineStyle = xlDouble
    
    '//Set the bottom border (double solid line)
    Selection.Borders(xlEdgeBottom).LineStyle = xlDouble
    
    '//Set the right border (double solid line)
    Selection.Borders(xlEdgeRight).LineStyle = xlDouble
    
    '//Set the inside vertical border (single solid line)
    Selection.Borders(xlInsideVertical).LineStyle = xlContinuous
    
    '//Set the inside horizontal border (single dotted line)
    Selection.Borders(xlInsideHorizontal).LineStyle = xlDot
    
    '//Set A1 as the active cell
    Worksheets("Sheet1").Range("A1").Select

End Sub

Change all references to "Sheet1" to the name of your worksheet.

This code should draw your required borders dynamically depending on how many rows of data you have in column A (it will also take into account any columns - I'm assuming the first row of your sheet is a header row - that may be added or removed in the future).

The code will run each time data is entered into any cell in column A (starting from row 2).

Hope this is what you require, but any questions, let me know...

Chris
 
Upvote 0
Maybe this.
Code: 
Sub MM1()
With ActiveSheet.UsedRange.Borders
        .LineStyle = xlContinuous
        .Color = vbRed
        .Weight = xlThin
    End With
End Sub
 
Upvote 0
THANKS to BOTH of you for loaning your expertise. I just noticed your replies and just had a chance to play with the codes. It seems that+with a very slight modification the code that Chris supplied works best for my scenario. Again THANKS for all your help. Have a GREAT day ALL :)
 
Upvote 0
I think this macro may also do what you want...
Code: 
Sub DataBorders()
  Dim LastRow As Long, LastCol As Long
  Cells.Borders.LineStyle = xlNone
  LastRow = Cells.Find("*", , xlValues, , xlRows, xlPrevious).Row
  LastCol = Cells.Find("*", , xlValues, , xlByColumns, xlPrevious).Column
  With Range("A2", Cells(LastRow, LastCol))
    .BorderAround xlDouble
    .Rows.Borders(xlInsideHorizontal).LineStyle = xlDash
    .Rows.Borders(xlInsideVertical).LineStyle = xlContinuous
  End With
End Sub
 
Last edited:
Upvote 0
Rick Rothstein said:
I think this macro may also do what you want...
Code: 
Sub DataBorders()
  Dim LastRow As Long, LastCol As Long
  Cells.Borders.LineStyle = xlNone
  LastRow = Cells.Find("*", , xlValues, , xlRows, xlPrevious).Row
  LastCol = Cells.Find("*", , xlValues, , xlByColumns, xlPrevious).Column
  With Range("A2", Cells(LastRow, LastCol))
    .BorderAround xlDouble
    .Rows.Borders(xlInsideHorizontal).LineStyle = xlDash
    .Rows.Borders(xlInsideVertical).LineStyle = xlContinuous
    [B][COLOR="#FF0000"].Columns.AutoFit[/COLOR][/B]
  End With
End Sub
Click to expand...
If you add the code I show in red above, your columns will automatically size themselves to the length of the data in them.
 
Upvote 0
This is a good code for me but is it possible to edit it to other columns and rows?
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)

    '//Define variables
    Dim LastRow As Integer      'variable to hold last row of data in column A
    Dim LastCol As Integer        'variable to hold last column of data (assuming row 1 contains headers)
    
    '//Only proceed if cell changed is in column A and row 2 onwards
    If Target.Column > 1 Or Target.Row = 1 Then Exit Sub
    
    '//Get the last row and column of data and assign to variable
    LastRow = Worksheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
    LastCol = Worksheets("Sheet1").Cells(1, Columns.Count).End(xlToLeft).Column
       
    '//Remove any existing borders that might exist
    Worksheets("Sheet1").Range("A2:AA65000").Select         '//Change the cell range to suit
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    
    '//If the LastRow variable is 1 then only the header row exists, therefore no formatting required, so stop execution
    If LastRow = 1 Then Exit Sub
    
    '//Set the cell range to add borders to
    Worksheets("Sheet1").Range(Cells(2, 1), Cells(LastRow, LastCol)).Select
    
    '//Set the left border (double solid line)
    Selection.Borders(xlEdgeLeft).LineStyle = xlDouble
    
    '//Set the top border (double solid line)
    Selection.Borders(xlEdgeTop).LineStyle = xlDouble
    
    '//Set the bottom border (double solid line)
    Selection.Borders(xlEdgeBottom).LineStyle = xlDouble
    
    '//Set the right border (double solid line)
    Selection.Borders(xlEdgeRight).LineStyle = xlDouble
    
    '//Set the inside vertical border (single solid line)
    Selection.Borders(xlInsideVertical).LineStyle = xlContinuous
    
    '//Set the inside horizontal border (single dotted line)
    Selection.Borders(xlInsideHorizontal).LineStyle = xlDot
    
    '//Set A1 as the active cell
    Worksheets("Sheet1").Range("A1").Select

End Sub

I need to modify follows
view
https://drive.google.com/file/d/1_UQlb85-x7aMqExTzRAzaprkWfvSsLxC/view?usp=sharing

Thank you for your advice
 
Upvote 0
You must log in or register to reply here.

Similar threads

U
  • Solved
VBA code with Formula that applies a Conditional Formatting border to a range of cells
Replies
9
Views
313
Peter_SSs
Peter_SSs
J
  • Question
Applying VBA to other cells
Replies
2
Views
183
NoSparks
N
C
  • Question
Adding Horizontal and/or Vertical borders with VBA.
Replies
0
Views
360
cr130
C
C
  • Question
Delete Cell Range, or Add Range and Copy Formulas etc. - Excel VBA
Replies
0
Views
83
CSTjr
C
H
  • Solved
VBA code to alter specific range to selection
2
Replies
10
Views
341
Joe4
Joe4

Forum statistics

Threads
1,215,172
Messages
6,123,447
Members
449,100
Latest member
sktz

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top