Hi all,
I have a macro (see below) that will create borders around a range of cells based on a numerical value entered into Column 'A' . However, I would like it to skip a cell if it contains a 1 (one).
Also I am trying to get it to ignore rows that already have borders assigned, if possible.
Here is the current macro:
Sub MULTIBORDERS2()
' MULTIBORDERS Macro
' Created by Larry A. Patzer
' Creates multiple borders based on a number
' being entered into Column A
'
Dim rng As Range
Dim Cell As Range
On Error GoTo XIT
Set rng = ActiveSheet.Columns("A").Cells
Set rng = rng.SpecialCells(xlCellTypeConstants, xlNumbers)
On Error GoTo 0
For Each Cell In rng.Cells
With Cell.Resize(1, 9)
With .BORDERS(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With .BORDERS(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .BORDERS(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .BORDERS(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With .BORDERS(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End With
Next Cell
Exit Sub
XIT:
MsgBox "No numeric values found in column A"
End Sub
I have a macro (see below) that will create borders around a range of cells based on a numerical value entered into Column 'A' . However, I would like it to skip a cell if it contains a 1 (one).
Also I am trying to get it to ignore rows that already have borders assigned, if possible.
Here is the current macro:
Sub MULTIBORDERS2()
' MULTIBORDERS Macro
' Created by Larry A. Patzer
' Creates multiple borders based on a number
' being entered into Column A
'
Dim rng As Range
Dim Cell As Range
On Error GoTo XIT
Set rng = ActiveSheet.Columns("A").Cells
Set rng = rng.SpecialCells(xlCellTypeConstants, xlNumbers)
On Error GoTo 0
For Each Cell In rng.Cells
With Cell.Resize(1, 9)
With .BORDERS(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With .BORDERS(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .BORDERS(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .BORDERS(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With .BORDERS(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End With
Next Cell
Exit Sub
XIT:
MsgBox "No numeric values found in column A"
End Sub