With the activecell in column C selected, this does a decent job of running from C to column V and formats the cells borders as wanted.

It is a bit slow but is not dealing with massive volumes of cells and its use is not "gotta get as many as possible done as soon as possible" type scenario.

However, I am wondering if there is a way to code this to act on a specified row that does the range all at once. Say an inputbox asking for the row number.

The inputbox I can do myself, the greater hurdles are this:

You will note that the first cell borders are three sided and then the next cell is four sided. So a two cell range in the row will have a left, right, top and bottom as a solid border line and a vertical light dotted line as a divider.

Secondly the row may have some cells that are colorindex various colors. (To tell the user these cells are reserved and not available.)

On the rows with the some colors in them, I need the border formatting code to skip those and continue to column V.

Skipping the colors is my major hurdle. And staying in sequence with the cells that take three borders and the cells that take four borders.

Thanks.
Howard


Option Explicit

Sub ReFormatRow()
'/ From column C to column V

Dim i As Long

For i = 1 To 10

With ActiveCell.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With

With ActiveCell.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With

With ActiveCell.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With

ActiveCell.Offset(, 1).Select

With ActiveCell.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlHairline
End With
With ActiveCell.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With ActiveCell.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With ActiveCell.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With

ActiveCell.Offset(, 1).Select
Next

End Sub

hi Howard,

here is an example, hoping that this might help you

Sub test()
Dim lgn As Range
Dim i As Integer, y As Integer

Set lgn = Application.InputBox(Prompt:= _
"Please select a row with your Mouse to be bolded.", _
Title:="SPECIFY ROW", Type:=8)

For i = 3 To 22 ' column C to column V
For y = 1 To 4 ' xlEdge
With Cells(lgn.Row, i).Borders(y)
If i = 8 Then .LineStyle = xlContinuous Else .LineStyle = xlDot
If i 3 And i < 22 Then .ColorIndex = 5 Else .ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Next
Next
End Sub

'1 = xlEdgeLeft
'2 = xlEdgeRight
'3 = xlEdgeTop
'4 = xlEdgeBottom
'5 = xlDiagonalDown
'6 = xlDiagonalUp

isabelle

On Thursday, January 23, 2014 8:35:52 PM UTC-8, isabelle wrote:
hi Howard,



here is an example, hoping that this might help you



Sub test()

Dim lgn As Range

Dim i As Integer, y As Integer



Set lgn = Application.InputBox(Prompt:= _

"Please select a row with your Mouse to be bolded.", _

Title:="SPECIFY ROW", Type:=8)



For i = 3 To 22 ' column C to column V

For y = 1 To 4 ' xlEdge

With Cells(lgn.Row, i).Borders(y)

If i = 8 Then .LineStyle = xlContinuous Else .LineStyle = xlDot

If i 3 And i < 22 Then .ColorIndex = 5 Else .ColorIndex = 0

.TintAndShade = 0

.Weight = xlThin

End With

Next

Next

End Sub



'1 = xlEdgeLeft

'2 = xlEdgeRight

'3 = xlEdgeTop

'4 = xlEdgeBottom

'5 = xlDiagonalDown

'6 = xlDiagonalUp



isabelle

Hi isabelle, thanks for taking a look.

I like your code as it is short and sweet. A step in the right direction but it produces borders of all dots on all four sides of the cell. With the exception of about the fourth cell in the row and the last in the row which seem to have the correct borders. Not seeing why that happens.
(I commented out the line that sets the borders to blue, as black is preferred.)

I was able to come up with code that does indeed format each cell correctly.. The bad news is its about a yard long but with screenupdating false, it runs pretty quick.

Both your code and mine fail to detect and ignore cells in the row that have highlighted color in them. Formats right over the colored cells.

That is the hurdle I cannot make work.

Here is a link if you are inclined to have a look. My code is in Module 4, right below yours. Also has some code to center-in-screen the area of the sheet the code is running on.

https://www.dropbox.com/s/phs2j66w3i...rop%20Box.xlsm

On sheet named "Blank" near cell W1 is a button with my code assigned to it.. X1 and Y1 are drop downs to select the Day and the Desk line to reformat..

It is set up to run on the Monday range and Desk 9 row. Just click the Reform button to run my code on that line.

I appreciate the help.

Regards,
Howard

hi Howard,

here is another example, hoping that this one might help you more

Sub test()
Dim lgn As Range
Dim i As Integer, y As Integer
Dim xledging
'xlEdgeLeft, xlEdgeRight, xlEdgeTop, xlEdgeBottom, xlInsideVertical,
xlInsideHorizontal, xlDiagonalUp, xlDiagonalDown
xledging = Array(xlEdgeLeft, xlEdgeRight, xlEdgeTop, xlEdgeBottom,
xlInsideVertical)

Set lgn = Application.InputBox(Prompt:= _
"Please select a row with your Mouse to be bolded.", _
Title:="SPECIFY ROW", Type:=8)

For i = 26 To 45 Step 2 ' column Z to column AS, , two cells at once
(Step 2)
For y = LBound(xledging) To UBound(xledging) ' 5 xledging 0 to 4
With Range(Cells(lgn.Row, i), Cells(lgn.Row, i + 1)).Borders(xledging(y))
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
If i = 26 And y = 0 Then .Weight = xlMedium ' test if is the first
cell and xlEdgeLeft
If i = 44 And y = 1 Then .Weight = xlMedium ' test if is the last
cell and xlEdgeRight
If y = 4 Then .Weight = xlHairline ' 4 = xlInsideVertical
End With
Next
Next
End Sub

isabelle

On Friday, January 24, 2014 7:37:36 PM UTC-8, isabelle wrote:
hi Howard,



here is another example, hoping that this one might help you more



Sub test()

Dim lgn As Range

Dim i As Integer, y As Integer

Dim xledging

'xlEdgeLeft, xlEdgeRight, xlEdgeTop, xlEdgeBottom, xlInsideVertical,

xlInsideHorizontal, xlDiagonalUp, xlDiagonalDown

xledging = Array(xlEdgeLeft, xlEdgeRight, xlEdgeTop, xlEdgeBottom,

xlInsideVertical)



Set lgn = Application.InputBox(Prompt:= _

"Please select a row with your Mouse to be bolded.", _

Title:="SPECIFY ROW", Type:=8)



For i = 26 To 45 Step 2 ' column Z to column AS, , two cells at once

(Step 2)

For y = LBound(xledging) To UBound(xledging) ' 5 xledging 0 to 4

With Range(Cells(lgn.Row, i), Cells(lgn.Row, i + 1)).Borders(xledging(y))

.LineStyle = xlContinuous

.ColorIndex = 0

.TintAndShade = 0

If i = 26 And y = 0 Then .Weight = xlMedium ' test if is the first

cell and xlEdgeLeft

If i = 44 And y = 1 Then .Weight = xlMedium ' test if is the last

cell and xlEdgeRight

If y = 4 Then .Weight = xlHairline ' 4 = xlInsideVertical

End With

Next

Next

End Sub



isabelle

I really like the compactness of this, hope I can adapt it.

I copied to a standard module and ran it, selected a row from Z to AS on prompt and hit enter. Get a Type Mismatch on this line.

For y = LBound(xledging) To UBound(xledging) ' 5 xledging 0 to 4

Am I using the code correctly selecting Z to AS?

I have had some success in using the code I posted in the link, where I can make it skip the colored cells. But it is a bit quirky on the sheet with some kinks to iron out.

The code is waaaay long and a ton of With / End With and same with Selection. But it does run quite quickly.

Can you elaborate a bit on how and what I should do with your code.

Sure appreciate it.

Howard

Hi Howard,

Am Fri, 24 Jan 2014 22:38:52 -0800 (PST) schrieb L. Howard:

I copied to a standard module and ran it, selected a row from Z to AS on prompt and hit enter. Get a Type Mismatch on this line.

have a try for Range Z:AS with:

Sub Test()
Dim myR As Range
Dim myRng As Range
Dim rngC As Range

Set myR = Application.InputBox("Select a cell into the row to reform", _
"Borders reform", Type:=8)

Set myRng = Range(Cells(myR.Row, "Z"), Cells(myR.Row, "AS"))

For Each rngC In myRng
With rngC
With .Borders(xlEdgeLeft)
.LineStyle = IIf(WorksheetFunction.IsOdd(rngC.Column), _
xlDot, xlContinuous)
.ColorIndex = xlAutomatic
.Weight = xlThin
End With
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.Weight = xlThin
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.Weight = xlThin
End With
With .Borders(xlEdgeRight)
.LineStyle = IIf(Not WorksheetFunction.IsOdd(rngC.Column), _
xlDot, xlContinuous)
.ColorIndex = xlAutomatic
.Weight = xlThin
End With
End With
Next
End Sub



Regards
Claus B.
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2

Hi Howard,

with range created by cell X1 and cell Y1 try:

Sub TestCB()
Dim myRng As Range
Dim rngC As Range

With Sheets("BLANK")
Set myRng = Intersect(Range(.Range("X1")), _
Range(.Range("X1")).Rows(Mid(.Range("Y1"), _
InStr(.Range("Y1"), " ") + 1, 99)))
End With

If Mid(myRng.Address, 2, 1) = "C" Then

For Each rngC In myRng
With rngC
With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.Weight = IIf(Not WorksheetFunction.IsOdd(rngC.Column), _
xlHairline, xlThin)
End With
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.Weight = xlThin
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.Weight = xlThin
End With
With .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.Weight = IIf(WorksheetFunction.IsOdd(rngC.Column), _
xlHairline, xlThin)
End With
End With
Next
Else
For Each rngC In myRng
With rngC
With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.Weight = IIf(WorksheetFunction.IsOdd(rngC.Column), _
xlHairline, xlThin)
End With
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.Weight = xlThin
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.Weight = xlThin
End With
With .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.Weight = IIf(Not WorksheetFunction.IsOdd(rngC.Column), _
xlHairline, xlThin)
End With
End With
Next
End If
With Sheets("BLANK")
.Range(.Range("X1")).BorderAround _
ColorIndex:=xlAutomatic, Weight:=xlMedium
End With
End Sub

Regards
Claus B.
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2