Micro to do borders question.

  • Thread starter Thread starter Damian
  • Start date Start date
D

Damian

I have a Micro that makes borders for certain range.
I would like to make this code better, because if you add extra row or
delete a row this micro will not do its job right.

The borders will always start at B31, but it can end anywhere. In B30 there
always will be the word "Area" and after the last cell to do borders it will
always be the word "Comments/Issues:".

so can it be done with a "if" statement if the see those words or is there
an other better way?

This is the code.
Sub FixBorders()


ActiveSheet.Unprotect Password:="eli"
Range("B31:O98").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With ActiveSheet
.Protect Password:="eli"
.EnableSelection = xlUnlockedCells
End With
End Sub

Thank you.
 
Hi,

Why not range name the last cell Last - select it and choose Insert, Name,
Define and enter Last in the Names in Workbook box and then click OK.

In your code replace

Range("B31:O98").Select

with

Range("B31", [Last]).Select
 
Here are some additional changes you might consider:

Sub FixBorders()
With Range("B31", [Last])
With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
End With
With .Borders(xlEdgeTop)
.LineStyle = xlDouble
.Weight = xlThick
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlDouble
.Weight = xlThick
End With
With .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
End With
With .Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With .Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlHairline
End With
End With
End Sub

To use this you would protect the spreadsheet but turn on the Format Cells
option in the protection dialog box. That way there is no need to hard code
the password into the code.
 
Great, Thank You.
One more thing,

Is there a way to have the the [Last] cell (B99:O99) BUT have the code to do
its job 1 cell up in B98:O98?
I tried to use the .End(xlDown)
but did not work.

Thanks

Shane Devenshire said:
Here are some additional changes you might consider:

Sub FixBorders()
With Range("B31", [Last])
With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
End With
With .Borders(xlEdgeTop)
.LineStyle = xlDouble
.Weight = xlThick
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlDouble
.Weight = xlThick
End With
With .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
End With
With .Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With .Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlHairline
End With
End With
End Sub

To use this you would protect the spreadsheet but turn on the Format Cells
option in the protection dialog box. That way there is no need to hard code
the password into the code.

--
If this helps, please click the Yes button.

Cheers,
Shane Devenshire


Damian said:
I have a Micro that makes borders for certain range.
I would like to make this code better, because if you add extra row or
delete a row this micro will not do its job right.

The borders will always start at B31, but it can end anywhere. In B30 there
always will be the word "Area" and after the last cell to do borders it will
always be the word "Comments/Issues:".

so can it be done with a "if" statement if the see those words or is there
an other better way?

This is the code.
Sub FixBorders()


ActiveSheet.Unprotect Password:="eli"
Range("B31:O98").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With ActiveSheet
.Protect Password:="eli"
.EnableSelection = xlUnlockedCells
End With
End Sub

Thank you.
Click to expand...
Click to expand...
 
Back
Top