Ensuring Conditional formating is not lost

[robert.gorczynski]

I have defined conditional formating for a range of cells in my
spreadsheet. What I need is a macro to ensure that if a user copies and
pastes into these cells the conditional formating is not lost. Any
ideas greatly appreciated?

My efforts so far are to display a warning message and undo the action
as below, although it does not work for multiple cells. If I have one
cell in my range I can check that formatConditions.count > 1 i.e there
is still some formatting. However the results are unpredictable if I
use a range of multiple cells.


Private Sub Worksheet_Change(ByVal Target As Range)

'Does the range still have conditional formating?

If HasValidation(Worksheets("Sheet1").Range("casefill")) Then
Exit Sub
Else

MsgBox "Data paste not allowed please use paste special. " & _
"See help for further details", vbCritical

'Application.Undo

End If
End Sub

Private Function HasValidation(r) As Boolean
' Return True if every cell in Range r uses Conditional Formating

Dim x As Integer

x = 0
x = r.FormatConditions.count
Debug.Print "count: " & x
If x > 0 Then HasValidation = True Else HasValidation = False

End Function

 

[Dave Peterson]

Maybe just check cell by cell???

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)

Dim myCell As Range
Dim myCFRng As Range

Set myCFRng = Me.Range("casefill")

If Intersect(myCFRng, Target) Is Nothing Then Exit Sub

On Error GoTo ErrHandler:

For Each myCell In Intersect(myCFRng, Target).Cells
If HasCF(myCell) Then
'do nothing
Else
With Application
.EnableEvents = False
.Undo
MsgBox "Data paste not allowed please use paste special. " & _
"See help for further details", vbCritical
Exit For
End With
End If
Next myCell

ErrHandler:
Application.EnableEvents = True
End Sub

Private Function HasCF(r As Range) As Boolean
Dim x As Long
x = r.FormatConditions.Count
HasCF = CBool(x <> 0)
End Function

 

[robert.gorczynski]

Dave!

Many thanks for taking the time to answer my thread. Almost there I
think, but can I have it so that the range I am looking at is the range
of cells that the user is trying to paste into?

In the example above not "casefill" but the target cells of the paste?

I have tried looking for a target property of a paste in VB but no joy.
What is the Target you have defined and used in the following code?:

If Intersect(myCFRng, Target) Is Nothing Then Exit Sub

Many thanks again

Rob.

 

[robert.gorczynski]

David!

Many thanks for your repsonse.

This seems to work fine for defined ranges, but can I extend this
futher so that the range to be checked is actually the range that the
user has pasted into?

i.e is the some sort of target property I can use. I have had a play
but can't seem to find anything suitable. What is the "Target" you have
defined in the follow line of code from your previous solution?

If Intersect(myCFRng, Target) Is Nothing Then Exit Sub


Many thanks again David,

Rob.

 

[robert.gorczynski]

David (and for anyone else who might be interested in this solution)

I've just cracked it in the following way:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)

Dim myCell As Range

On Error GoTo ErrHandler:

For Each myCell In Target.Cells
If HasCF(myCell) Then
'do nothing
Else
With Application
.EnableEvents = False
.Undo

MsgBox "Standard paste not allowed please use paste special and select
paste values only. " & _
"See help for further details", vbCritical


Exit For
End With
End If
Next myCell

ErrHandler:
Application.EnableEvents = True
End Sub


Private Function HasCF(r As Range) As Boolean
Dim x As Long
x = r.FormatConditions.Count
HasCF = CBool(x <> 0)
End Function