Jay,
Okay, how about this?
This solution provides a toolbar to switch highlighting on and off for every
sheet in the workbook. It allows setting highlighting, and then setting row
and column highlighting individually. The button tooltiptext shows whether
it is set or not, so you can easily check (although it is quite obvious with
the colours <G>)
There is quite a bit of code. The first bit is workbook event code.
To input this code, right click on the Excel icon on the worksheet
(or next to the File menu if you maximise your workbooks),
select View Code from the menu, and paste the code
Option Explicit
Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error Resume Next
Application.CommandBars("Hiliter").Delete
On Error GoTo 0
End Sub
Private Sub Workbook_Open()
On Error Resume Next
Application.CommandBars("Hiliter").Delete
On Error GoTo 0
With Application.CommandBars
With .Add(Name:="Hiliter", temporary:=True)
With .Controls.Add(Type:=msoControlButton)
.Caption = "Hiliter"
.Style = msoButtonCaption
End With
Set ocHiliter = .Controls.Add(Type:=msoControlButton)
With ocHiliter
.BeginGroup = True
.FaceId = 20
.Tag = "Hiliter"
.OnAction = "setHiliter"
End With
Set ocHiliterRow = .Controls.Add(Type:=msoControlButton)
With ocHiliterRow
.FaceId = 1652
.Tag = "Row"
.OnAction = "setHiliter"
End With
Set ocHiliterCol = .Controls.Add(Type:=msoControlButton)
With ocHiliterCol
.FaceId = 1650
.Tag = "Column"
.OnAction = "setHiliter"
End With
.Visible = True
End With
End With
CheckHiliterNames
End Sub
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
CheckHiliterNames
Hilite Sh, ActiveCell
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target
As Range)
Hilite Sh, Target
End Sub
The next bit goes in a standard code module
Option Explicit
Option Private Module
Public fHiliter As Boolean
Public fRowHiliter As Boolean
Public fColHiliter As Boolean
Public ocHiliter As CommandBarControl
Public ocHiliterRow As CommandBarControl
Public ocHiliterCol As CommandBarControl
Private Sub SetHiliter()
With ThisWorkbook
Select Case Application.CommandBars.ActionControl.Tag
Case "Hiliter":
fHiliter = Not fHiliter
.Names.Add Name:=.ActiveSheet.Name & _
"!__Hilite", RefersTo:=fHiliter
.Names.Add Name:=.ActiveSheet.Name & _
"!__HiliteRow", RefersTo:=fHiliter
.Names.Add Name:=.ActiveSheet.Name & _
"!__HiliteCol", RefersTo:=fHiliter
Case "Row":
fRowHiliter = Not fRowHiliter
.Names.Add Name:=.ActiveSheet.Name & _
"!__HiliteRow", RefersTo:=fRowHiliter
Case "Column":
fColHiliter = Not fColHiliter
.Names.Add Name:=.ActiveSheet.Name & _
"!__HiliteCol", RefersTo:=fColHiliter
End Select
End With
CheckHiliterNames
Hilite ActiveSheet, ActiveCell
End Sub
Public Sub Hilite(ByVal Sh As Object, ByVal Target As Range)
Sh.Cells.FormatConditions.Delete
If fHiliter Then
With Target
If fRowHiliter Then
With .EntireRow
.FormatConditions.Add Type:=xlExpression,
Formula1:="TRUE"
With .FormatConditions(1)
With .Borders(xlTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 5
End With
With .Borders(xlBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 5
End With
.Interior.ColorIndex = 20
End With
End With
End If 'fRowHiliter
If fColHiliter Then
With .EntireColumn
.FormatConditions.Delete
.FormatConditions.Add Type:=xlExpression,
Formula1:="TRUE"
With .FormatConditions(1)
With .Borders(xlLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 5
End With
With .Borders(xlRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 5
End With
.Interior.ColorIndex = 20
End With
End With
End If 'fColHiliter
.FormatConditions.Delete
.FormatConditions.Add Type:=xlExpression, Formula1:="TRUE"
.FormatConditions(1).Interior.ColorIndex = 36
End With
End If
End Sub
Public Sub CheckHiliterNames()
Dim sButtonSuffix As String
With ThisWorkbook
On Error Resume Next
fHiliter = Evaluate(.Names(.ActiveSheet.Name & _
"!__Hilite").RefersTo)
If Err.Number <> 0 Then
.Names.Add Name:=.ActiveSheet.Name & "!__Hilite",
RefersTo:=fHiliter
.Names.Add Name:=.ActiveSheet.Name & "!__HiliteRow",
RefersTo:=fHiliter
.Names.Add Name:=.ActiveSheet.Name & "!__HiliteCol",
RefersTo:=fHiliter
End If
On Error GoTo 0
sButtonSuffix = IIf(fHiliter, "Set", "Not set")
ocHiliter.Caption = "Toggle highlighting - " & sButtonSuffix
On Error Resume Next
fRowHiliter = Evaluate(.Names(.ActiveSheet.Name & _
"!__HiliteRow").RefersTo)
If Err.Number <> 0 Then
.Names.Add Name:=.ActiveSheet.Name & "!__HiliteRow",
RefersTo:=fRowHiliter
End If
On Error GoTo 0
sButtonSuffix = IIf(fRowHiliter, "Set", "Not set")
ocHiliterRow.Caption = "Row Hiliter - " & sButtonSuffix
On Error Resume Next
fColHiliter = Evaluate(.Names(.ActiveSheet.Name & _
"!__HiliteCol").RefersTo)
If Err.Number <> 0 Then
.Names.Add Name:=.ActiveSheet.Name & "!__HiliteCol",
RefersTo:=fColHiliter
End If
On Error GoTo 0
sButtonSuffix = IIf(fColHiliter, "Set", "Not set")
ocHiliterCol.Caption = "Column Hiliter - " & sButtonSuffix
.Names(.ActiveSheet.Name & "!__Hilite").Visible = False
.Names(.ActiveSheet.Name & "!__HiliteRow").Visible = False
.Names(.ActiveSheet.Name & "!__HiliteCol").Visible = False
End With
End Sub
--
HTH
Bob Phillips
(remove nothere from email address if mailing direct)