View Single Post
  #5   Report Post  
Posted to microsoft.public.excel.programming
redleg redleg is offline
external usenet poster
 
Posts: 12
Default Change background colour of selected cells

Great stuff Greg. Far more elegant than my attempts.
Protected was not reset if .Count 1.
Fixed that but removed the test in the end because I have some merged cells.

Thanks for your solution,

Redleg

"Greg Wilson" wrote:

I suggest you substitute the following. The problem with the previous version
is that it will protect the wks even if it wasn't protected to begin with.
This one will only protect it if it was already protected. Otherwise it could
be a nuisance depending on what you are doing. The same comments hold
regarding the password.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim protected As Boolean
protected = Me.ProtectContents
If protected Then Me.Unprotect ' "mypassword"
Cells.FormatConditions.Delete
If Len(copyval) 0 Then CopyToClip (copyval)
With Target
If .Count 1 Then Exit Sub
copyval = .Value
.FormatConditions.Add Type:=xlExpression, Formula1:="TRUE"
.FormatConditions(1).Interior.ColorIndex = 19
End With
If protected Then Me.Protect ' "mypassword"
End Sub

Greg

"Redleg" wrote:

Thanks for the help so far Greg.

In both options I get a runtime error "Unable to set the ColorIndex property
of the interior class"

"Greg Wilson" wrote:

This version appears to adequately compensate for the problem described if
you need to only copy and paste values. You will need to set a reference to
the Microsoft Forms 2.0 Object Library for it to work. Paste all of the below
to the worksheet's code module. Minimal testing and never used personally:-

Dim copyval As String

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Cells.FormatConditions.Delete
If Len(copyval) 0 Then CopyToClip (copyval)
With Target
If .Count 1 Then Exit Sub
copyval = .Value
.FormatConditions.Add Type:=xlExpression, Formula1:="TRUE"
.FormatConditions(1).Interior.ColorIndex = 19
End With
End Sub

Private Sub CopyToClip(txt)
Dim DataObj As DataObject
Set DataObj = New DataObject
DataObj.SetText txt
DataObj.PutInClipboard
Set DataObj = Nothing
End Sub

Regards,
Greg