ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   border every other cell in range (https://www.excelbanter.com/excel-programming/370684-border-every-other-cell-range.html)

cass calculator

border every other cell in range
 
I'm trying to write a macro that will apply a bottom border to every
other cell in a range. the macro only needs to work for horizontal
ranges, and not for vertical ones.

the closest i can get is the code below, but this only applys borders
to cells in odd columns. i need it to apply borders to every other
cell in a selection, regardless if it is even or odd.

Sub BotBorderOdd()
For Each cell In Selection
If Application.WorksheetFunction.Odd(cell.Column) = cell.Column
Then
oRange = oRange & "," & cell.Address
End If
Next cell
oRange = Mid(oRange, 2, Len(oRange) - 1)
Range(oRange).Select
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End Sub

Thanks for your help everyone!


Tom Ogilvy

border every other cell in range
 

If you want the second cell in the selection underlined and every 2nd cell
after
Sub BotBorderOdd()
Dim lFlag As Long
lFlag = Selection(1).Column Mod 2
For Each cell In Selection
If cell.Column Mod 2 < lFlag Then
oRange = oRange & "," & cell.Address

With cell.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End If
Next
End Sub

if you want to start with the first cell, change < to = in the IF statement

--
Regards,
Tom Ogilvy

"cass calculator" wrote:

I'm trying to write a macro that will apply a bottom border to every
other cell in a range. the macro only needs to work for horizontal
ranges, and not for vertical ones.

the closest i can get is the code below, but this only applys borders
to cells in odd columns. i need it to apply borders to every other
cell in a selection, regardless if it is even or odd.

Sub BotBorderOdd()
For Each cell In Selection
If Application.WorksheetFunction.Odd(cell.Column) = cell.Column
Then
oRange = oRange & "," & cell.Address
End If
Next cell
oRange = Mid(oRange, 2, Len(oRange) - 1)
Range(oRange).Select
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End Sub

Thanks for your help everyone!




All times are GMT +1. The time now is 01:17 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com