PDA

View Full Version : highlight specific cells in active row/column



MIKERM
04-21-2010, 01:16 PM
Hi ,

I borrowed the macro below from another site and modified it slightly. I have a data grid in which I am applying this to. Some cells are filled with a particular colour to indicate an event, others (non events) are simply left with no fill. (appear white). I am stuck as to how to make the macro below only highlight the white (non event) cells without removing the colour from the cells which already have a designated fill.

Thanks very much for you help,

please see the attament


Option Explicit
'/////////////////////////////////////////////////////
'// Amended 14th Feb 2003 - suggestion by Juan Pablo G.
'// International versons may NOT recognise TRUE
'// Suggestion use =1 which evaluates to TRUE,
'// in fact any number that <> 0
'////////////////////////////////////////////////////
Const iInternational As Integer = Not (0)

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Cells(1, 1) = "True" Then
Dim iColor As Integer
'// Note: Don't use if you have conditional
'// formatting that you want to keep
'// On error resume in case user selects a range of cells
On Error Resume Next
iColor = Target.Interior.ColorIndex
'// Leave On Error ON for Row offset errors
If iColor < 0 Then
iColor = 36
Else
iColor = iColor + 1
End If
'// Need this test in case Font color is the same
If iColor = Target.Font.ColorIndex Then iColor = iColor + 1
Cells.FormatConditions.Delete

'// Horizontal color banding
With Range("A" & Target.Row, Target.Address) 'Rows(Target.Row)
.FormatConditions.Add Type:=2, Formula1:="TRUE"
.FormatConditions(1).Interior.ColorIndex = iColor
End With
'// Vertical color banding
With Range(Target.Offset(1000 + Target.Row, 0).Address & ":" & _
Target.Offset(1, 0).Address) 'Rows(Target.Row)
.FormatConditions.Add Type:=2, Formula1:="TRUE"
.FormatConditions(1).Interior.ColorIndex = iColor
End With
'// Vertical color banding
With Range(Target.Offset(1 - Target.Row, 0).Address & ":" & _
Target.Offset(-1, 0).Address) 'Rows(Target.Row)
.FormatConditions.Add Type:=2, Formula1:="TRUE"
.FormatConditions(1).Interior.ColorIndex = iColor
End With
End If
End Sub

mdmackillop
04-21-2010, 02:30 PM
Welcome to VBAX

Give this a try


Option Explicit

Const iInternational As Integer = Not (0)

Dim OldRng As Range

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Rw As Long, Col As Long, Rng As Range, cel As Range
Dim i As Long

On Error GoTo exits

If Not OldRng Is Nothing Then OldRng.Interior.ColorIndex = xlNone

Col = Target.Column
Rw = Target.Row
i = -1
Do Until Target.Offset(, i).Interior.ColorIndex = xlNone
i = i - 1
Loop

Set Rng = Target.Offset(, i)
For Each cel In Range(Cells(Rw, "H"), Target.Offset(, -1))
If cel.Interior.ColorIndex = xlNone Then Set Rng = Union(Rng, cel)
Next
For Each cel In Range(Cells(8, Col), Target.Offset(-1))
If cel.Interior.ColorIndex = xlNone Then Set Rng = Union(Rng, cel)
Next
For Each cel In Range(Cells(Rw + 50, Col), Target.Offset(1))
If cel.Interior.ColorIndex = xlNone Then Set Rng = Union(Rng, cel)
Next
Rng.Interior.ColorIndex = 6
Set OldRng = Rng
exits:
End Sub

Private Sub Worksheet_Activate()
Dim cel As Range
For Each cel In ActiveSheet.UsedRange
If cel.Interior.ColorIndex = 6 Then cel.Interior.ColorIndex = xlNone
Next
End Sub

MIKERM
04-21-2010, 02:49 PM
Wow!...thats more than I thought could be done, you've even limited the formatting to occur only within the data grid itsel f.. This is way beyond my basic knowedge of VBA, but thank you very much!:biggrinro