Micro to do borders question.

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.
 
S

Shane Devenshire

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
 
S

Shane Devenshire

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.
 
D

Damian

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...
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

help needed with borders 2
VBA code question 1
Macro: Insert Row above Totals 6
with, end with format 2
Auto Write Name and Merge across 0
Border Problem 2
C++ OLE automation - how do I format the borders? 19
Loops through Sheets but doesn't work. 5

Top