Restore formats in merged cells ...
 

Hi,

I have a O.K. routine today that restore format when merged cells are the
target in a worksheet_change event. The code is like below - for testing
merge cells A1:D1 and forward to row 10.

Now I need to restore format by button and need to change the routine to
work with all merged cells from A1:D1 to A10:D10. How can I do that - I've
tried a while now but can't get the procedure right. Please help. Manybe
your solution can handle the last two inhibited row to unlock cells and
unhide them ...:? The button connection is not a probelm -the probelm is to
reference the merged cells, make the object right, to take them one by one
in a loop or...?


(To test routine: Merge cells A1:D1 and forward to row 10)

Private Sub Worksheet_Change(ByVal Target As Range)
'****** Restore merged cells format by change ************

If Not Application.Intersect(Target, Sheet1.Range("A1:D10")) Is Nothing Then
Target.NumberFormat = "@"
With Target
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
With Target.Font
.Name = "Arial"
.FontStyle = "Normal"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
End With

' ----------Need borders around mergedcells, not within their cells
Dim sel As Range
Set sel = Sheet1.Range(Cells(Target.Row, Target.Column),
Cells(Target.Row, Target.Column + 3))

sel.Borders(xlDiagonalDown).LineStyle = xlNone
sel.Borders(xlDiagonalUp).LineStyle = xlNone
With sel.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 1
End With
With sel.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 37
End With
With sel.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 37
End With
With sel.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 1
End With
sel.Borders(xlInsideVertical).LineStyle = xlNone
With Target.Interior
.ColorIndex = 36
.Pattern = xlSolid
.PatternColorIndex = 10
End With

sel.FormatConditions.Delete

'sel.Locked = False
'sel.FormulaHidden = False

End If

End Sub

Restore formats in merged cells ...
 

I don't really understand what you are what you want to do so I'll try and
answer the following in isolation from the rest of your question.

-the probelm is to
reference the merged cells, make the object right, to take them one by one
in a loop or...?

Assuming you want to apply same formats to the entire range you can
reference as one range object and apply formats in one go.

With Range("A1:D10")
.whatever_format = some format
End with

The only additional format you might want to apply is -
..Borders(xlInsideHorizontal)

But note this would generate an error if the range is only one row (as would
xlInsideVertical if only one column).

In passing -

With Target.Interior
.ColorIndex = 36
.Pattern = xlSolid
.PatternColorIndex = 10
End With

Is there any point to apply .PatternColorIndex / colour without a pattern.

Regards,
Peter T


"Marie J-son" wrote in message
...
Hi,

I have a O.K. routine today that restore format when merged cells are the
target in a worksheet_change event. The code is like below - for testing
merge cells A1:D1 and forward to row 10.

Now I need to restore format by button and need to change the routine to
work with all merged cells from A1:D1 to A10:D10. How can I do that - I've
tried a while now but can't get the procedure right. Please help. Manybe
your solution can handle the last two inhibited row to unlock cells and
unhide them ...:? The button connection is not a probelm -the probelm is
to
reference the merged cells, make the object right, to take them one by one
in a loop or...?


(To test routine: Merge cells A1:D1 and forward to row 10)

Private Sub Worksheet_Change(ByVal Target As Range)
'****** Restore merged cells format by change ************

If Not Application.Intersect(Target, Sheet1.Range("A1:D10")) Is Nothing
Then
Target.NumberFormat = "@"
With Target
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
With Target.Font
.Name = "Arial"
.FontStyle = "Normal"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
End With

' ----------Need borders around mergedcells, not within their cells
Dim sel As Range
Set sel = Sheet1.Range(Cells(Target.Row, Target.Column),
Cells(Target.Row, Target.Column + 3))

sel.Borders(xlDiagonalDown).LineStyle = xlNone
sel.Borders(xlDiagonalUp).LineStyle = xlNone
With sel.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 1
End With
With sel.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 37
End With
With sel.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 37
End With
With sel.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 1
End With
sel.Borders(xlInsideVertical).LineStyle = xlNone
With Target.Interior
.ColorIndex = 36
.Pattern = xlSolid
.PatternColorIndex = 10
End With

sel.FormatConditions.Delete

'sel.Locked = False
'sel.FormulaHidden = False

End If

End Sub

Explanation - Union doesn't work with format mergecells...
 

Hi,

I want to ensure the formats after someone make cut and past, drag and drop
etc. If so, the format vanishes. If someone drag another cell with a
different PatternColorIndex, I had to have the PatternColorIndex = 10. In
some worksheets I have inhibited drag and drop and cut possibility, but I
can't do that in all.
If users have changed the format accidently like drag and drop, there is an
protection on the sheet - the users will not be able to restor it them
selves..

This is more specific how I tried to solve the problem and get the error
right now. Since there is a lot of different cells, I have used Union to
aggreate the similar cells together. An Example: Set rngBNot =
Union(Range("H2:J30"), Range("H32:J40"), Range("H42:J46"), Range("H48:J54"))

With this rngBNot I then run the procedure, and when ".MergeCells = True"
line comes, it can't handle the union, but want to create one single merged
cell of it.
I've thought of kind of loop through mergeareas or something, but this is on
the edge of my skill ...


'------------G20:J59 CHECKLIST NOTES --------------------------------

With rngBNot
.NumberFormat = "@"
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With


Hope this clarify
/Regards


"Peter T" <peter_t@discussions skrev i meddelandet
...
I don't really understand what you are what you want to do so I'll try and
answer the following in isolation from the rest of your question.

-the probelm is to
reference the merged cells, make the object right, to take them one by
one
in a loop or...?

Assuming you want to apply same formats to the entire range you can
reference as one range object and apply formats in one go.

With Range("A1:D10")
.whatever_format = some format
End with

The only additional format you might want to apply is -
.Borders(xlInsideHorizontal)

But note this would generate an error if the range is only one row (as
would
xlInsideVertical if only one column).

In passing -

With Target.Interior
.ColorIndex = 36
.Pattern = xlSolid
.PatternColorIndex = 10
End With

Is there any point to apply .PatternColorIndex / colour without a pattern.

Regards,
Peter T


"Marie J-son" wrote in message
...
Hi,

I have a O.K. routine today that restore format when merged cells are the
target in a worksheet_change event. The code is like below - for testing
merge cells A1:D1 and forward to row 10.

Now I need to restore format by button and need to change the routine to
work with all merged cells from A1:D1 to A10:D10. How can I do that -
I've
tried a while now but can't get the procedure right. Please help. Manybe
your solution can handle the last two inhibited row to unlock cells and
unhide them ...:? The button connection is not a probelm -the probelm is
to
reference the merged cells, make the object right, to take them one by
one
in a loop or...?


(To test routine: Merge cells A1:D1 and forward to row 10)

Private Sub Worksheet_Change(ByVal Target As Range)
'****** Restore merged cells format by change ************

If Not Application.Intersect(Target, Sheet1.Range("A1:D10")) Is Nothing
Then
Target.NumberFormat = "@"
With Target
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
With Target.Font
.Name = "Arial"
.FontStyle = "Normal"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
End With

' ----------Need borders around mergedcells, not within their cells
Dim sel As Range
Set sel = Sheet1.Range(Cells(Target.Row, Target.Column),
Cells(Target.Row, Target.Column + 3))

sel.Borders(xlDiagonalDown).LineStyle = xlNone
sel.Borders(xlDiagonalUp).LineStyle = xlNone
With sel.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 1
End With
With sel.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 37
End With
With sel.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 37
End With
With sel.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 1
End With
sel.Borders(xlInsideVertical).LineStyle = xlNone
With Target.Interior
.ColorIndex = 36
.Pattern = xlSolid
.PatternColorIndex = 10
End With

sel.FormatConditions.Delete

'sel.Locked = False
'sel.FormulaHidden = False

End If

End Sub

Explanation - Union doesn't work with format mergecells...
 

If I follow the only problem is merging a multiple area range - right?

Assuming you want each row in each area merged -

Dim ar As Range

With rngBNot
' format stuff
For Each ar In .Areas
ar.Merge True ' the True arg merges each row
Next

End With

Regards,
Peter T

"Marie J-son" wrote in message
...
Hi,

I want to ensure the formats after someone make cut and past, drag and
drop
etc. If so, the format vanishes. If someone drag another cell with a
different PatternColorIndex, I had to have the PatternColorIndex = 10. In
some worksheets I have inhibited drag and drop and cut possibility, but I
can't do that in all.
If users have changed the format accidently like drag and drop, there is
an
protection on the sheet - the users will not be able to restor it them
selves..

This is more specific how I tried to solve the problem and get the error
right now. Since there is a lot of different cells, I have used Union to
aggreate the similar cells together. An Example: Set rngBNot =
Union(Range("H2:J30"), Range("H32:J40"), Range("H42:J46"),
Range("H48:J54"))

With this rngBNot I then run the procedure, and when ".MergeCells = True"
line comes, it can't handle the union, but want to create one single
merged
cell of it.
I've thought of kind of loop through mergeareas or something, but this is
on
the edge of my skill ...


'------------G20:J59 CHECKLIST NOTES --------------------------------

With rngBNot
.NumberFormat = "@"
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With


Hope this clarify
/Regards


"Peter T" <peter_t@discussions skrev i meddelandet
...
I don't really understand what you are what you want to do so I'll try
and
answer the following in isolation from the rest of your question.

-the probelm is to
reference the merged cells, make the object right, to take them one by
one
in a loop or...?

Assuming you want to apply same formats to the entire range you can
reference as one range object and apply formats in one go.

With Range("A1:D10")
.whatever_format = some format
End with

The only additional format you might want to apply is -
.Borders(xlInsideHorizontal)

But note this would generate an error if the range is only one row (as
would
xlInsideVertical if only one column).

In passing -

With Target.Interior
.ColorIndex = 36
.Pattern = xlSolid
.PatternColorIndex = 10
End With

Is there any point to apply .PatternColorIndex / colour without a
pattern.

Regards,
Peter T


"Marie J-son" wrote in message
...
Hi,

I have a O.K. routine today that restore format when merged cells are
the
target in a worksheet_change event. The code is like below - for
testing
merge cells A1:D1 and forward to row 10.

Now I need to restore format by button and need to change the routine
to
work with all merged cells from A1:D1 to A10:D10. How can I do that -
I've
tried a while now but can't get the procedure right. Please help.
Manybe
your solution can handle the last two inhibited row to unlock cells and
unhide them ...:? The button connection is not a probelm -the probelm
is
to
reference the merged cells, make the object right, to take them one by
one
in a loop or...?


(To test routine: Merge cells A1:D1 and forward to row 10)

Private Sub Worksheet_Change(ByVal Target As Range)
'****** Restore merged cells format by change ************

If Not Application.Intersect(Target, Sheet1.Range("A1:D10")) Is Nothing
Then
Target.NumberFormat = "@"
With Target
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
With Target.Font
.Name = "Arial"
.FontStyle = "Normal"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
End With

' ----------Need borders around mergedcells, not within their cells
Dim sel As Range
Set sel = Sheet1.Range(Cells(Target.Row, Target.Column),
Cells(Target.Row, Target.Column + 3))

sel.Borders(xlDiagonalDown).LineStyle = xlNone
sel.Borders(xlDiagonalUp).LineStyle = xlNone
With sel.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 1
End With
With sel.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 37
End With
With sel.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 37
End With
With sel.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 1
End With
sel.Borders(xlInsideVertical).LineStyle = xlNone
With Target.Interior
.ColorIndex = 36
.Pattern = xlSolid
.PatternColorIndex = 10
End With

sel.FormatConditions.Delete

'sel.Locked = False
'sel.FormulaHidden = False

End If

End Sub

Restore formats in merged cells ...
 

Instead of reapplying all the formats after the user screws it up, er, modifies
the formatting, maybe you could keep a hidden sheet that has all the formats you
want.

Then just copy|paste special|formats whenever they touch one of those ranges.



Marie J-son wrote:

Hi,

I have a O.K. routine today that restore format when merged cells are the
target in a worksheet_change event. The code is like below - for testing
merge cells A1:D1 and forward to row 10.

Now I need to restore format by button and need to change the routine to
work with all merged cells from A1:D1 to A10:D10. How can I do that - I've
tried a while now but can't get the procedure right. Please help. Manybe
your solution can handle the last two inhibited row to unlock cells and
unhide them ...:? The button connection is not a probelm -the probelm is to
reference the merged cells, make the object right, to take them one by one
in a loop or...?

(To test routine: Merge cells A1:D1 and forward to row 10)

Private Sub Worksheet_Change(ByVal Target As Range)
'****** Restore merged cells format by change ************

If Not Application.Intersect(Target, Sheet1.Range("A1:D10")) Is Nothing Then
Target.NumberFormat = "@"
With Target
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
With Target.Font
.Name = "Arial"
.FontStyle = "Normal"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
End With

' ----------Need borders around mergedcells, not within their cells
Dim sel As Range
Set sel = Sheet1.Range(Cells(Target.Row, Target.Column),
Cells(Target.Row, Target.Column + 3))

sel.Borders(xlDiagonalDown).LineStyle = xlNone
sel.Borders(xlDiagonalUp).LineStyle = xlNone
With sel.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 1
End With
With sel.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 37
End With
With sel.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 37
End With
With sel.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 1
End With
sel.Borders(xlInsideVertical).LineStyle = xlNone
With Target.Interior
.ColorIndex = 36
.Pattern = xlSolid
.PatternColorIndex = 10
End With

sel.FormatConditions.Delete

'sel.Locked = False
'sel.FormulaHidden = False

End If

End Sub

--

Dave Peterson

Yes, if copy paste for the user doesn't become killed ....
 

Thanks for the suggestion Dave,

Unfortunately do I have investigated that and found that this would
eliminate users own copy paste operations, since the VBA code use the
clipboard ...do you know a way to save clipboard content, make vba
copy-paste, and then insert the information again.

The solution only need to handle string values in cells (but can't be
interferred with merged cells, more than one area selected, selected
drawings etc)

Can this work? I just found out that I still can't copy paste between sheets
(despite a huge effeort to rmake restore vba procedures for different cells
and formats ..., because there seems always to be something that
UserInterFaceOnly doesn't handle, like on worksheet_activate events run code
like:
* Add validation
* CellDragAndDrop commands

.... and sometimes the worksbook protection fight against it. You use to have
good ideas, Dave - any one popping up now?

/Kind regards



"Dave Peterson" skrev i meddelandet
...
Instead of reapplying all the formats after the user screws it up, er,
modifies
the formatting, maybe you could keep a hidden sheet that has all the
formats you
want.

Then just copy|paste special|formats whenever they touch one of those
ranges.



Marie J-son wrote:

Hi,

I have a O.K. routine today that restore format when merged cells are the
target in a worksheet_change event. The code is like below - for testing
merge cells A1:D1 and forward to row 10.

Now I need to restore format by button and need to change the routine to
work with all merged cells from A1:D1 to A10:D10. How can I do that -
I've
tried a while now but can't get the procedure right. Please help. Manybe
your solution can handle the last two inhibited row to unlock cells and
unhide them ...:? The button connection is not a problem -the problem is
to
reference the merged cells, make the object right, to take them one by
one
in a loop or...?

(To test routine: Merge cells A1:D1 and forward to row 10)

Private Sub Worksheet_Change(ByVal Target As Range)
'****** Restore merged cells format by change ************

If Not Application.Intersect(Target, Sheet1.Range("A1:D10")) Is Nothing
Then
Target.NumberFormat = "@"
With Target
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
With Target.Font
.Name = "Arial"
.FontStyle = "Normal"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
End With

' ----------Need borders around mergedcells, not within their cells
Dim sel As Range
Set sel = Sheet1.Range(Cells(Target.Row, Target.Column),
Cells(Target.Row, Target.Column + 3))

sel.Borders(xlDiagonalDown).LineStyle = xlNone
sel.Borders(xlDiagonalUp).LineStyle = xlNone
With sel.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 1
End With
With sel.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 37
End With
With sel.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 37
End With
With sel.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 1
End With
sel.Borders(xlInsideVertical).LineStyle = xlNone
With Target.Interior
.ColorIndex = 36
.Pattern = xlSolid
.PatternColorIndex = 10
End With

sel.FormatConditions.Delete

'sel.Locked = False
'sel.FormulaHidden = False

End If

End Sub

--

Dave Peterson

Yes, if copy paste for the user doesn't become killed ....
 

Lots of things in macros kill the clipboard.

And when event macros are used, you may never be able to get to the
clipboard--since it can be killed when the event fires.

Maybe you could use workbook_beforesave to apply the formatting. And hope that
the user won't care if the clipboard is lost.

Or just make the macro get called when the user wants it (a button on the
worksheet???).

Then you could get out of the macro if there's something in the clipboard.

if application.cutcopymode < false then exit sub

I've never seen a way to save that clipboard.


Marie J-son wrote:

Thanks for the suggestion Dave,

Unfortunately do I have investigated that and found that this would
eliminate users own copy paste operations, since the VBA code use the
clipboard ...do you know a way to save clipboard content, make vba
copy-paste, and then insert the information again.

The solution only need to handle string values in cells (but can't be
interferred with merged cells, more than one area selected, selected
drawings etc)

Can this work? I just found out that I still can't copy paste between sheets
(despite a huge effeort to rmake restore vba procedures for different cells
and formats ..., because there seems always to be something that
UserInterFaceOnly doesn't handle, like on worksheet_activate events run code
like:
* Add validation
* CellDragAndDrop commands

... and sometimes the worksbook protection fight against it. You use to have
good ideas, Dave - any one popping up now?

/Kind regards

"Dave Peterson" skrev i meddelandet
...
Instead of reapplying all the formats after the user screws it up, er,
modifies
the formatting, maybe you could keep a hidden sheet that has all the
formats you
want.

Then just copy|paste special|formats whenever they touch one of those
ranges.



Marie J-son wrote:

Hi,

I have a O.K. routine today that restore format when merged cells are the
target in a worksheet_change event. The code is like below - for testing
merge cells A1:D1 and forward to row 10.

Now I need to restore format by button and need to change the routine to
work with all merged cells from A1:D1 to A10:D10. How can I do that -
I've
tried a while now but can't get the procedure right. Please help. Manybe
your solution can handle the last two inhibited row to unlock cells and
unhide them ...:? The button connection is not a problem -the problem is
to
reference the merged cells, make the object right, to take them one by
one
in a loop or...?

(To test routine: Merge cells A1:D1 and forward to row 10)

Private Sub Worksheet_Change(ByVal Target As Range)
'****** Restore merged cells format by change ************

If Not Application.Intersect(Target, Sheet1.Range("A1:D10")) Is Nothing
Then
Target.NumberFormat = "@"
With Target
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
With Target.Font
.Name = "Arial"
.FontStyle = "Normal"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
End With

' ----------Need borders around mergedcells, not within their cells
Dim sel As Range
Set sel = Sheet1.Range(Cells(Target.Row, Target.Column),
Cells(Target.Row, Target.Column + 3))

sel.Borders(xlDiagonalDown).LineStyle = xlNone
sel.Borders(xlDiagonalUp).LineStyle = xlNone
With sel.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 1
End With
With sel.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 37
End With
With sel.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 37
End With
With sel.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 1
End With
sel.Borders(xlInsideVertical).LineStyle = xlNone
With Target.Interior
.ColorIndex = 36
.Pattern = xlSolid
.PatternColorIndex = 10
End With

sel.FormatConditions.Delete

'sel.Locked = False
'sel.FormulaHidden = False

End If

End Sub

--

Dave Peterson

--

Dave Peterson