Derek
Here´s another approach.
The below function returns the complementary range
of two ranges. If you have two ranges A an B, then
A's complement in regard to B is all the cells in A, which are
not in B. This function may come up handy in several situations.
In your example SuperRange is C5:H33 and SubRange is F5:F33,
so the complementrange is C5:E33 + G5:H33, the range you want
to keep its formatting.
This setup will do the job:
Place the function in a general module.
Function ComplementaryRange(SuperRange As Range, _
SubRange As Range) As Range
'Leo Heuser, 11 July 2003
Dim ComplementRange As Range
Dim Counter As Long
Dim PartRange(1 To 4) As Range
On Error Resume Next
Set SubRange = Intersect(SuperRange, SubRange)
With SuperRange
Set PartRange(1) = Cells(.Row, .Column).Resize(SubRange.Row - _
.Row, .Columns.Count)
Set PartRange(2) = Cells(SubRange.Row, .Column). _
Resize(SubRange.Rows.Count, SubRange.Column - .Column)
Set PartRange(3) = Cells(SubRange.Row, SubRange.Column + _
SubRange.Columns.Count). _
Resize(SubRange.Rows.Count, .Columns.Count - (SubRange.Column -
_
.Column + SubRange.Columns.Count))
Set PartRange(4) = Cells(SubRange.Row + SubRange.Rows.Count,
..Column). _
Resize(.Rows.Count - (SubRange.Row - .Row +
SubRange.Rows.Count), _
.Columns.Count)
End With
For Counter = 1 To 4
If Not PartRange(Counter) Is Nothing Then
If ComplementRange Is Nothing Then
Set ComplementRange = PartRange(Counter)
Else
Set ComplementRange = Union(ComplementRange, _
PartRange(Counter))
End If
End If
Next Counter
Set ComplementaryRange = ComplementRange
On Error Goto 0
End Function
Make the following adjustments to your code:
Private Sub workbook_sheetchange(ByVal sh As Object, ByVal Target As Range)
Dim ComplementRange As Range
On Error Resume Next
If Not Intersect(Target, Range("f5:f33")) Is Nothing Then
If Target.Value >= 0.5 Then
Target.Font.ColorIndex = 3: Target.Font.FontStyle = "bold"
Else
Target.Font.ColorIndex = 1: Target.Font.FontStyle = "normal"
End If
Set ComplementRange =
ComplementaryRange(Range("C5:H33"),Range("F5:F33"))
With ComplementRange.Font
.ColorIndex = 1
.FontStyle = "normal"
End With
End If
End Sub
--
Best Regards
Leo Heuser
MVP Excel
Followup to newsgroup only, please.
"derek" <(E-Mail Removed)> skrev i en meddelelse
news:092801c34790$47ce21e0$(E-Mail Removed)...
> Excel 2000
> With a previous question and your help I'm up and running
> with the code below. But I need a last bit of help please
> to find away round a glitch..
> Users enter data into the sheet within a range of C5:H33.
> For ease they sometime copy and paste part of a row into
> the next row but sometime paste it into the wrong cell.
> The result is the red/bold format if present in the F5:F33
> (from the code below) is transfered to another cell. How
> can I ensure that all other cells other than the F5:F33
> range remains black and normal when data is enterd either
> directly or copied from a cell with red/bold format?
>
> Private Sub workbook_sheetchange(ByVal sh As Object, ByVal
> Target As Range)
> On Error Resume Next
>
> If Not Intersect(Target, Range("f5:f33")) Is Nothing Then
> If Target.Value >= 0.5 Then
> Target.Font.ColorIndex = 3: Target.Font.FontStyle = "bold"
> Else
> Target.Font.ColorIndex = 1: Target.Font.FontStyle
> = "normal"
> End If
> End If
> End Sub
>
> TIA Derek..
|
Similar Threads
