A working copy of this that you can upload and use is he
http://www.jlathamsite.com/uploads/A...ight_forEd.xls
All of this code goes into the specific sheet's code module. No doubt that
the editor here is going to break some lines so might be better to cut and
paste from the sample into your workbook. I've tried to anticipate the
breaks, but ... Instructions for getting into a worksheet's code module can
be found he
http://www.jlathamsite.com/Teach/WorksheetCode.htm
The sheet name is not important, and the code automatically adjusts for any
added rows of data, and as long as your titles in row 5 extend on out without
a break (empty cell), the highlighting of that row will work properly.
Option Explicit
Dim LastHighlightedRow As Long
Dim LastHighlightedCol As Long
Const FirstDataRow = 6
Const FirstDataCol = 5
Const LastPossibleRow = 65536 ' change for Excel 2007
Const Red = 3
Const Orange = 46
Private Sub Worksheet_Activate()
Dim LastDataColumn As Long ' for Excel 2007
Dim ColumnToExamine As Long ' again for Excel 2007
Dim DataRange As String
Dim anyCell As Object
Application.EnableEvents = False
'set up Orange highlighting of used columns
'could take some time, depending on speed of system
LastDataColumn = Range("A" & _
FirstDataRow - 1).End(xlToRight).Column
For ColumnToExamine = FirstDataCol To LastDataColumn
SetColumnTitleShading ColumnToExamine - 1 ' using as an Offset
Next
'initialize values if possible
If ActiveCell.Row = FirstDataRow Then
LastHighlightedRow = ActiveCell.Row
End If
If ActiveCell.Column = FirstDataCol Then
LastHighlightedCol = ActiveCell.Column
End If
'set red highlight in column title if needed
If LastHighlightedRow 0 And LastHighlightedCol 0 Then
Range("A1").Offset(FirstDataRow - 2, _
LastHighlightedCol - 1).Interior.ColorIndex = Red
Else
'find last selected cell in data range
'THIS! could take a while for large data area!!
DataRange = Range("A1").Offset(FirstDataRow - 1, _
FirstDataCol - 1).Address & ":" & _
Selection.SpecialCells(xlCellTypeLastCell).Address
For Each anyCell In Range(DataRange)
If anyCell.Interior.ColorIndex = Red Then
LastHighlightedRow = anyCell.Row
LastHighlightedCol = anyCell.Column
Exit For ' quit, we found it
End If
Next
End If
Application.EnableEvents = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim currentRow As Long
Dim currentCol As Long
Dim DataRange As String
Dim anyCell As Object
If Target.Row < FirstDataRow Or Target.Column < FirstDataCol Then
Exit Sub ' not in data area
End If
Application.EnableEvents = False
currentRow = Target.Row
currentCol = Target.Column
'remove highlight from previously selected cell
'if last selected cell is outside of the data range then
'LastHighlightedRow and LastHighlightedCol will be zero
If LastHighlightedRow 0 And LastHighlightedCol 0 Then
Range("A1").Offset(LastHighlightedRow - 1, _
LastHighlightedCol - 1).Interior.ColorIndex = xlNone
Else
'find a red cell in data area?
DataRange = Range("A1").Offset(FirstDataRow - 1, _
FirstDataCol - 1).Address & ":"
DataRange = DataRange & _
Selection.SpecialCells(xlCellTypeLastCell).Address
For Each anyCell In Range(DataRange)
If anyCell.Interior.ColorIndex = Red Then
LastHighlightedRow = anyCell.Row
LastHighlightedCol = anyCell.Column
Exit For ' quit, we found it
End If
Next
End If
ActiveCell.Interior.ColorIndex = Red ' highlight selected cell
'changed columns? as moving across sheet?
If currentCol < LastHighlightedCol Then
If LastHighlightedCol 0 Then
'reset previous Row 5 title shading
SetColumnTitleShading LastHighlightedCol - 1
End If
Range("A1").Offset(FirstDataRow - 2, _
currentCol - 1).Interior.ColorIndex = Red
LastHighlightedCol = currentCol
End If
'changed rows? as moving up/down sheet?
If currentRow < LastHighlightedRow Then
If LastHighlightedRow 0 Then
Rows(LastHighlightedRow).Interior.ColorIndex = xlNone
End If
Range("A" & currentRow & ":D" & _
currentRow).Interior.ColorIndex = Red
LastHighlightedRow = currentRow
End If
Application.EnableEvents = True
End Sub
Private Sub SetColumnTitleShading(WhichColumn As Long)
If Range("A1").Offset(LastPossibleRow - 1, _
WhichColumn).End(xlUp).Row < FirstDataRow Then
Range("A1").Offset(FirstDataRow - 2, _
WhichColumn).Interior.ColorIndex = xlNone
Else
Range("A1").Offset(FirstDataRow - 2, _
WhichColumn).Interior.ColorIndex = Orange
End If
End Sub
"Ed" wrote:
Hello I am working in Excel 2007, on a long Table from $A$1:$DO$9 so far
which will be growing vertically with each entry, and maybe in some special
cases new columns will be added but not often at all. Data is located from
E6:DO9, the rest of the cells in the Table are just Headers and so on. So
what I would like to have is the following:
A)
When the active cell is inside E6:D09, for example:
G6, to have $A6:$D6 highlighted in red lets say, and G$5 in red as well...
if I move to cell G7, I would have $A7:$D7 and G$5 in red, and if I move to
H7, I would have$A7:$D7 and H$5 higlighted.
B)
Aside from that I guess this part is a bit more complicated, I hope it is
possible as well... Each row is a entry, so on a row I will have several
cells with data (a number, the rest are empty) so on the current row to
highlight the titles (row 5) which have data in the current row, in orange.
So in summary, the idea is to highlight the titles (Row 5) that have data on
the active row in orange and at the same time to highlight the current title
(Row 5) and A:D of the current row in Red... I really hope I was able to
explain myself...
Thank you very much for your attention!