Sub everyN()
'------------------ BEGIN - USER MODIFIABLE SECTION ----------------------
r_step = 4 ' N, the number of rows between the enhanced row borders
thick_top = True ' extra emphasis on TOP edge of selection
thick_bottom = True ' extra emphasis on BOTTOM edge of selection
'------------------ END - USER MODIFIABLE SECTION ------------------------
' everyN Macro by Robert Simms written March 1997
' last modified on 18 Oct 2001
' o Purpose: Place a border below every N (user option) rows in a range the
' user has selected, without affecting other cell attributes.
' A medium thickness border is set along the top of the first row
' and at the bottom of the last row (user option).
'
' o This macro is best used by storing it in a file by itself. Then use
' the view/toolbars/customize menu to create a custom button with this
' macro assigned to it. It would be good to modify the picture for
' the button to suggest 'bolding every few lines'.
' -- this has been done in a toolbar attached to this file.
Dim a As Range
Set a = Selection ' save current selection
If a.Cells.Count = a.EntireColumn.Cells.Count Then
MsgBox "Please select entire rows or a finite range of cells" & _
" rather than entire columns."
Exit Sub
End If
r_header = a.Row - 1 ' a header row would be prior to first row of selection
Application.ScreenUpdating = False ' False for faster macro
With a.Borders(xlEdgeTop)
'.LineStyle = xlContinuous
'.ColorIndex = xlAutomatic
If thick_top Then
.Weight = xlMedium
Else
.Weight = xlThin
End If
End With
' Turn off all inside horizontal borders.
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlNone
End With
For Each r In a.Rows
If (r.Row - r_header) Mod r_step = 0 Then
r.Select ' this doesn't work well when cells are merged accross rows
Selection.Borders(xlBottom).Weight = xlThin
End If
Next
With a.Borders(xlEdgeBottom)
'.LineStyle = xlContinuous
'.ColorIndex = xlAutomatic
If thick_bottom Then
.Weight = xlMedium
Else
.Weight = xlThin
End If
End With
Application.ScreenUpdating = True ' Restore setting
' Restore original selection
a.Select
End Sub