VBA: How to put borders around ceration ranges - vba

I'm struggling with a macro that places thick borders around certain ranges. I've included an example that illustrates the problem.
I will appreciate if you can help me with this issue.
https://app.box.com/s/i0qi02agje7pzf2it3jlds0w8atsplnu


If you don't want inside vertical or inside horizontal:
Sheet1.Range("A1:B10").BorderAround xlContinuous, xlThick


Macro recorder gave me:
Range("F10:G13").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Clean it up a bit
With Range("F10:G13")
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
.Borders(xlInsideVertical).LineStyle = xlNone
.Borders(xlInsideHorizontal).LineStyle = xlNone
End With
Could put this in a function and pass it a range.

Related

VBA - Simpler Code for Formatting

I was hoping that there is simpler code for my formatted cells below. The goal of this code is to make a box look a bit nicer, nothing overly fancy, just simple and this code doesn't look simple.
Range("C17:C25").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
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Range("A17:C25").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Range("C17:C25").Select
With Selection.Font
.ColorIndex = xlAutomatic
.Name = "Arial"
.Size = 12
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
I recorded with macros obviously, however, it is very clunky and I am sure that some of it can be taken out, just unsure what can and can't be taken out/modified.
Thanks in advance.

Try this. You can dispense with the selects too. Most of the formatting at the end is probably redundant, unless you have previous settings, and looks as if it was generated by the macro recorder.
Sub x()
With Range("C17:C25")
With .Borders
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With .Font
.ColorIndex = xlAutomatic
.Name = "Arial"
.Size = 12
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
With .Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End With
With Range("A17:C25")
.BorderAround LineStyle:=xlContinuous, ColorIndex:=0, Weight:=xlMedium
With .Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
End With
End Sub

I reformatted it once again to something even simpler. I'd love some feed back to ensure I am not doing anything taboo.
With Range("C17:C25")
With .Borders
.LineStyle = xlContinuous
.Weight = xlThin
End With
With .Font
.ColorIndex = xlAutomatic
.Name = "Arial"
.Size = 12
End With
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
With .Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End With
With Range("A17:C25")
.BorderAround LineStyle:=xlContinuous, Weight:=xlMedium
With .Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
End With
End With

VBA to draw borders

Below is the code that i use on one of my spreadsheet to do the formatting and it works without any error.
It's bit lengthy because I got this from Macro Recorder and modified a bit.
The problem I am encountering with this script is that it takes around 5 to 10 seconds to get the job done.
Is there anyway to shorten this code and speed up the process?
Sub FORMAT()
Application.ScreenUpdating = False
Range("B5:EM5000").Select
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
'''''
Range("B5:D5").Select
Range(Selection, Selection.End(xlDown)).Select
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlDouble
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlDouble
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlDouble
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlDouble
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.TintAndShade = 0
.Weight = xlHairline
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.TintAndShade = 0
.Weight = xlHairline
End With
'''''
Range("B5:c5").Select
Range(Selection, Selection.End(xlDown)).Offset(0, 3).Select
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlDouble
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlDouble
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlDouble
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlDouble
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.TintAndShade = 0
.Weight = xlHairline
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.TintAndShade = 0
.Weight = xlHairline
End With
'''''
Range("B5:c5").Select
Range(Selection, Selection.End(xlDown)).Resize(, 25).Offset(0, 5).Select
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlDouble
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlDouble
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlDouble
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlDouble
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.TintAndShade = 0
.Weight = xlHairline
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.TintAndShade = 0
.Weight = xlHairline
End With
'''''
Range("B5:c5").Select
Range(Selection, Selection.End(xlDown)).Resize(, 11).Offset(0, 27).Select
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlDouble
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlDouble
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlDouble
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlDouble
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.TintAndShade = 0
.Weight = xlHairline
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.TintAndShade = 0
.Weight = xlHairline
End With
'''''
'''''
Range("B5:l5").Select
Range(Selection, Selection.End(xlDown)).Offset(0, 39).Select
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlDouble
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlDouble
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlDouble
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlDouble
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.TintAndShade = 0
.Weight = xlHairline
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.TintAndShade = 0
.Weight = xlHairline
End With
''''''''''''''
'''''
Range("B5:k5").Select
Range(Selection, Selection.End(xlDown)).Offset(0, 50).Select
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlDouble
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlDouble
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlDouble
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlDouble
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.TintAndShade = 0
.Weight = xlHairline
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.TintAndShade = 0
.Weight = xlHairline
End With
''''''''''''''
'''''
Range("B5:k5").Select
Range(Selection, Selection.End(xlDown)).Offset(0, 60).Select
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlDouble
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlDouble
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlDouble
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlDouble
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.TintAndShade = 0
.Weight = xlHairline
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.TintAndShade = 0
.Weight = xlHairline
End With
''''''''''''''
'''''
Range("B5:k5").Select
Range(Selection, Selection.End(xlDown)).Offset(0, 70).Select
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlDouble
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlDouble
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlDouble
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlDouble
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.TintAndShade = 0
.Weight = xlHairline
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.TintAndShade = 0
.Weight = xlHairline
End With
''''''''''''''
'''''
Range("B5:k5").Select
Range(Selection, Selection.End(xlDown)).Offset(0, 80).Select
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlDouble
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlDouble
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlDouble
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlDouble
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.TintAndShade = 0
.Weight = xlHairline
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.TintAndShade = 0
.Weight = xlHairline
End With
''''''''''''''
'''''
Range("B5:k5").Select
Range(Selection, Selection.End(xlDown)).Offset(0, 90).Select
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlDouble
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlDouble
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlDouble
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlDouble
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.TintAndShade = 0
.Weight = xlHairline
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.TintAndShade = 0
.Weight = xlHairline
End With
''''''''''''''
'''''
Range("B5:k5").Select
Range(Selection, Selection.End(xlDown)).Offset(0, 100).Select
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlDouble
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlDouble
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlDouble
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlDouble
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.TintAndShade = 0
.Weight = xlHairline
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.TintAndShade = 0
.Weight = xlHairline
End With
''''''''''''''
Range("B5:k5").Select
Range(Selection, Selection.End(xlDown)).Offset(0, 110).Select
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlDouble
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlDouble
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlDouble
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlDouble
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.TintAndShade = 0
.Weight = xlHairline
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.TintAndShade = 0
.Weight = xlHairline
End With
''''''''''''''
''''''''''''''
Range("B5:k5").Select
Range(Selection, Selection.End(xlDown)).Offset(0, 120).Select
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlDouble
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlDouble
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlDouble
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlDouble
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.TintAndShade = 0
.Weight = xlHairline
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.TintAndShade = 0
.Weight = xlHairline
End With
''''''''''''''
''''''''''''''
Range("B5:k5").Select
Range(Selection, Selection.End(xlDown)).Offset(0, 130).Select
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlDouble
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlDouble
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlDouble
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlDouble
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.TintAndShade = 0
.Weight = xlHairline
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.TintAndShade = 0
.Weight = xlHairline
End With
''''''''
''''''''''''''
Range("B5:k5").Select
Range(Selection, Selection.End(xlDown)).Offset(0, 140).Select
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlDouble
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlDouble
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlDouble
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlDouble
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.TintAndShade = 0
.Weight = xlHairline
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.TintAndShade = 0
.Weight = xlHairline
End With
Range("B5").Select
Range(Selection, Selection.End(xlDown)).Offset(0, 38).Select
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlDouble
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlDouble
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlDouble
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlDouble
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.TintAndShade = 0
.Weight = xlHairline
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.TintAndShade = 0
.Weight = xlHairline
End With
''''''''
''''''''''''''
Range("AP5").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Rows.AutoFit
''''''''''''''
Range("e:f").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.NumberFormat = "mmm-yy;#"
Range("g:h").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.NumberFormat = "#,##0"
''''''
Range("B5:EM5000").Select
With Selection.Font
.Name = "Calibri"
.SIZE = 8
End With
Application.ScreenUpdating = True
End Sub

I use this code to erase the borders in a selected area and redraw a thin border around the same area. Not sure if this will help anyone.
Sub noborder_border()
'
' noborder_border Macro
'
' Keyboard Shortcut: Ctrl+Shift+B
'
With Selection
.Borders(xlEdgeLeft).LineStyle = xlNone
.Borders(xlEdgeRight).LineStyle = xlNone
.Borders(xlEdgeTop).LineStyle = xlNone
.Borders(xlEdgeBottom).LineStyle = xlNone
.Borders(xlInsideVertical).LineStyle = xlNone
.Borders(xlInsideHorizontal).LineStyle = xlNone
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
End With
With Selection
.Borders(xlEdgeLeft).LineStyle = xlContinuous
.Borders(xlEdgeLeft).Weight = xlThin
.Borders(xlEdgeRight).LineStyle = xlContinuous
.Borders(xlEdgeRight).Weight = xlThin
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlEdgeTop).Weight = xlThin
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeBottom).Weight = xlThin
End With
End Sub

Think about borders as lines: Top, Right, Bottom, Left, Vertical lines (inside the range) and Horizontal lines (inside the range)
One line of code will draw all of the lines for the range. You can modify them to get what you want.
To have a clean code and better control on the execution of code, you should learn to write functions, as an example, I wrote a function that gives you the last row in a given column in a given worksheet.
Sub DrawBorder()
Dim lRow As Integer
Dim cell As Range
Dim rng As Range
Dim WS As Worksheet
Set WS = ActiveSheet 'you can set this to a specific sheet like Set WS=Sheets("Sheet1")
'Clear all of the borders in the sheet
WS.Cells.Borders.LineStyle = xlNone
'Find the last row in column B=2
lRow = LastRowInColumn(WS, 2)
Set rng = WS.Range("B5:D" & lRow)
'Borders of the cells inside the range
rng.Borders.LineStyle = xlDot
'Border of the range as a whole with double lines
rng.Borders(xlEdgeTop).LineStyle = xlDouble
rng.Borders(xlEdgeBottom).LineStyle = xlDouble
rng.Borders(xlEdgeLeft).LineStyle = xlDouble
rng.Borders(xlEdgeRight).LineStyle = xlDouble
' 'You can use these lines to remove the vertical/horizontal lines isnide a range
' rng.Borders(xlInsideVertical).LineStyle = xlNone
' rng.Borders(xlInsideHorizontal).LineStyle = xlNone
End Sub
Function LastRowInColumn(Optional sh As Worksheet, Optional colNumber As Long = 1) As Long
'Finds the last row in a particular column which has a value in it
If sh Is Nothing Then
Set sh = ActiveSheet
End If
LastRowInColumn = sh.Cells(sh.Rows.Count, colNumber).End(xlUp).Row
End Function

Sub Gray_Grid_Lines()
' This sets all the grid lines to a light gray
Cells.Select
With Selection
.Borders.LineStyle = xlContinuous
.Borders.ThemeColor = 1
.Borders.TintAndShade = -0.15
.Borders.Weight = xlThin
End With
Range("A1").Select
End Sub

Border drawing can be performed quickly using a loop.The start and end column number of the loop is specified:
For m = 0 To LbCols
With Sheets("YourSheet").Cells(Rows.Count, 1).End(xlUp).Offset(0, m).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = 23
End With
Next
Source

Select a range of cells, delete the empty ones, and then add border around remaining cells

I would like to use a macro that will look at a range of cells, delete out the empty rows, and then add a border around the remaining cells that actually has content. Here are two macros I have: One is for removing the empty cells, and the other is to add borders. As I mentioned, the issue is, I do not know how to tell Excel to only add a border around the cells that were left over after the Remove macro was completed. I would appreciate any help.
**Sub Remove()**
'
' Remove Macro
'
'
Range("B80:B95").Select
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.EntireRow.Delete
ActiveWindow.SmallScroll Down:=-12
Range("B61:B77").Select
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.EntireRow.Delete
ActiveWindow.SmallScroll Down:=-21
Range("B39:B58").Select
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.EntireRow.Delete
ActiveWindow.SmallScroll Down:=-27
Range("B10:B28").Select
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.EntireRow.Delete
ActiveWindow.SmallScroll Down:=-6
End Sub
and
**Sub Border()**
'
' Border Macro
'
'
Range("B7:K19").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
ActiveWindow.SmallScroll Down:=18
Range("B21:K74").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
ActiveWindow.SmallScroll Down:=54
Range("O76").Select
ActiveWindow.SmallScroll Down:=-81
End Sub

I assume your B to K columns will always remain constant. You basically just want to find the total "used" rows...
Dim cols As Integer, LastRow As Long, TestRow As Long
LastRow = 0
For cols = 2 to 11
TestRow = Cells(Rows.Count, cols).End(xlUp).Row
If TestRow > LastRow Then LastRow = TestRow
Next cols
Range("B7:K" & LastRow).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
ActiveWindow.SmallScroll Down:=18
Range("B21:K74").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
ActiveWindow.SmallScroll Down:=54
Range("O76").Select
ActiveWindow.SmallScroll Down:=-81
I really hate the use of .Select but I am not rewriting all your other code.

Row selection and putting border using VBA macros in excel

I Need to find the non empty rows in a sheet from row 13 and put a top thick border to the selected non empty rows till the last used rows of the sheet. from the column C i need to find the non empty row. I tried this code but it is not working. can u plz help me out
Sub rowfind3()
Dim cell As Range
Dim r1 As Range
For Each cell In ActiveSheet.Range("C:C")
If (cell.Value <> "") Then
Set r1 = Range("A" & ActiveCell.Row & ":AV" & ActiveCell.Row)
r1.Select
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 = xlMedium
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(xlInsideHorizontal).LineStyle = xlNone
End If
Next cell
End Sub
In this code only the first row the border is displayed, however for the successive rows the border is not coming.
Also i tried another code for the above scenario, but the same first row is only the border is displayed.
Sub rowfind1()
'
' rowfind Macro
'
'
Dim r1 As Range
Dim lr As Variant
Dim i As Integer
lr = ActiveSheet.UsedRange.Rows.Count
i = 0
For i = 13 To lr - 11
If (Not (IsEmpty(Cells(i, 3).Value))) Then
Set r1 = Range("A" & ActiveCell.Row & ":AV" & ActiveCell.Row)
r1.Select
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 = xlMedium
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(xlInsideHorizontal).LineStyle = xlNone
End If
Next i
End Sub

Firstly, no need to use selection. All that ends up doing is potentially confusing the code (as in this case). Secondly, theres no need to re-declare the range inside the loop. Thats what the loop is there for.
Here is how it should look:
Sub rowfind3()
Dim cell As Range
For Each cell In ActiveSheet.Range("C:C")
If (cell.Value <> "") Then
With cell.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With cell.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With cell.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With cell.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
End If
Next cell
End Sub
I would look at changing the Activesheet to reference the actual sheet you want it on and only look at the UsedRange as well to speed it up a bit, but that code will now at least get you there.
Addendum based on Comments clarification:
lr = ActiveSheet.Cells(ActiveSheet.Rows.Count, "C").End(xlUp).Row
With ActiveSheet.Range("C13:C" & lr)
With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
.Borders(xlInsideHorizontal).LineStyle = xlNone
End With

Did you consider to use Conditional Formatting? For example on Columns $A:$AV formula is =$A1<>"", in formatting choose borders.

Excel 2003 - VBA for looping through every cell in a row to provide attributes/formatting

say I want to make the first row of the excel ss something like this:
.Rows("1:1").Select
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
only I want each individual cells to have the outline, not the entire selection. how can i say for each cell in row 1, do the above idea
Thanks!

Also set the xlInsideHorizontal
Record a Macro, and the result was
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
'I think this is what you were missing
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With

That's easy:
Dim c As Range
For Each c In ActiveSheet.Range("1:1")
c.Select
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
Next
But this may take a very long time, so set Application.ScreenUpdating to false before you start!