nousername
03-18-2008, 11:56 AM
First let me say that the code below works great, but I need to extend it's funtionality.
Support requested:
How can this code be modified to highlight only from column A through column F? I think that it has some to do with these lines in the code below:
'Range to check is the entire row
If bRw Then
Set rRng = Range(Target.EntireRow.Address)
Else
Set rRng = Range(Target.EntireColumn.Address)
End If
Option Explicit
'*This resets some of the sheets formatting!
Dim bSwitch As Boolean
Dim bRw As Boolean
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
'On double click, reset the sheet's formatting (only with highlighter shut off)
If bSwitch Then Exit Sub
With Application
.EnableEvents = False
With Cells
.Interior.ColorIndex = 0
.Font.Bold = False
End With
.EnableEvents = True
End With
End Sub
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
'Enable user to switch highlighter on/off with a right click prompt
If bSwitch Then
If MsgBox("Shut off the highlighter?", 36) = 7 Then Exit Sub
Else
If MsgBox("Turn on the highlighter?", 36) = 7 Then Exit Sub
End If
'Toggle boolean variable on/off switch
If Selection.Rows.Count > 1 Then
bRw = False
Else
bRw = True
End If
bSwitch = Not bSwitch
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'If we are running procedure or not:
If Not bSwitch Then Exit Sub
'This holds the name of the hidden defined name that
'we use to store the old target rows address in
Const szRCName As String = "rgnRC"
Dim rRng As Excel.Range
Dim szOldTarget As String
Dim vArrCellTypes As Variant
Dim vCell As Variant
'Store the special cells types that we use in an array
vArrCellTypes = Array(xlCellTypeConstants, xlCellTypeFormulas, xlCellTypeAllValidation)
On Error Resume Next
'Create a valid row address by cutting the extra's from
'the named ranges RefersTo value
szOldTarget = Replace$(Names(szRCName).RefersTo, "=", "")
szOldTarget = Replace$(szOldTarget, """", "")
Application.EnableEvents = False
Application.ScreenUpdating = False
'Reset color of the old target row:
With Range(szOldTarget)
.Interior.ColorIndex = 0
.Font.Bold = False
End With
'Range to check is the entire row
If bRw Then
Set rRng = Range(Target.EntireRow.Address)
Else
Set rRng = Range(Target.EntireColumn.Address)
End If
'=======================================================
'Loop through the SpecialCell types array:
For Each vCell In vArrCellTypes
'Format the cells we find:
With rRng.SpecialCells(CLng(vCell))
.Interior.ColorIndex = 15
.Font.Bold = True
End With
Next vCell
'=======================================================
'Update our defined name with the row address:
'The defined name is set to hidden so it cannot be viewed
'in the Names dialog, change to suit.
If bRw Then
Names.Add szRCName, Target.EntireRow.Address, False
Else
Names.Add szRCName, Target.EntireColumn.Address, False
End If
Application.EnableEvents = True
Application.ScreenUpdating = True
'Explicitly clear memory
Set rRng = Nothing
End Sub
Support requested:
How can this code be modified to highlight only from column A through column F? I think that it has some to do with these lines in the code below:
'Range to check is the entire row
If bRw Then
Set rRng = Range(Target.EntireRow.Address)
Else
Set rRng = Range(Target.EntireColumn.Address)
End If
Option Explicit
'*This resets some of the sheets formatting!
Dim bSwitch As Boolean
Dim bRw As Boolean
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
'On double click, reset the sheet's formatting (only with highlighter shut off)
If bSwitch Then Exit Sub
With Application
.EnableEvents = False
With Cells
.Interior.ColorIndex = 0
.Font.Bold = False
End With
.EnableEvents = True
End With
End Sub
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
'Enable user to switch highlighter on/off with a right click prompt
If bSwitch Then
If MsgBox("Shut off the highlighter?", 36) = 7 Then Exit Sub
Else
If MsgBox("Turn on the highlighter?", 36) = 7 Then Exit Sub
End If
'Toggle boolean variable on/off switch
If Selection.Rows.Count > 1 Then
bRw = False
Else
bRw = True
End If
bSwitch = Not bSwitch
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'If we are running procedure or not:
If Not bSwitch Then Exit Sub
'This holds the name of the hidden defined name that
'we use to store the old target rows address in
Const szRCName As String = "rgnRC"
Dim rRng As Excel.Range
Dim szOldTarget As String
Dim vArrCellTypes As Variant
Dim vCell As Variant
'Store the special cells types that we use in an array
vArrCellTypes = Array(xlCellTypeConstants, xlCellTypeFormulas, xlCellTypeAllValidation)
On Error Resume Next
'Create a valid row address by cutting the extra's from
'the named ranges RefersTo value
szOldTarget = Replace$(Names(szRCName).RefersTo, "=", "")
szOldTarget = Replace$(szOldTarget, """", "")
Application.EnableEvents = False
Application.ScreenUpdating = False
'Reset color of the old target row:
With Range(szOldTarget)
.Interior.ColorIndex = 0
.Font.Bold = False
End With
'Range to check is the entire row
If bRw Then
Set rRng = Range(Target.EntireRow.Address)
Else
Set rRng = Range(Target.EntireColumn.Address)
End If
'=======================================================
'Loop through the SpecialCell types array:
For Each vCell In vArrCellTypes
'Format the cells we find:
With rRng.SpecialCells(CLng(vCell))
.Interior.ColorIndex = 15
.Font.Bold = True
End With
Next vCell
'=======================================================
'Update our defined name with the row address:
'The defined name is set to hidden so it cannot be viewed
'in the Names dialog, change to suit.
If bRw Then
Names.Add szRCName, Target.EntireRow.Address, False
Else
Names.Add szRCName, Target.EntireColumn.Address, False
End If
Application.EnableEvents = True
Application.ScreenUpdating = True
'Explicitly clear memory
Set rRng = Nothing
End Sub