View Single Post
  #4   Report Post  
Posted to microsoft.public.excel.misc
JLatham JLatham is offline
external usenet poster
 
Posts: 2,203
Default Need a "Tailored" Highlighting Macro

Ed,
Either I'm not understanding things here, or it's not quite working right
where you're using it.
What SHOULD happen is that initially any columns from E out to DO (and
beyond) that have any entry in the column below them should be highlighted
orange.

When you select a cell in within the data area (E6:DO9 from example, but DO
and 9 are variable and should automatically adjust) then cells A:D on that
row and the cell you selected should turn Red along with the cell in row 5 of
that column. When you move off to another column in the same row, old cell
should turn plain white, new selected cell should turn red, old cell in Row 5
should either turn unshaded or back to orange depending on whether or not
there's data in that old column, and new column, Row 5 cell should turn red.

Examples:
You choose Cell H8:
A8:D8 and H5 go to red along with H8 itself

You then select I8 (moving over 1 column)
A8:D8 remain red, H8 clears, and I8 and I5 turn red, and
H5 either goes clear (no data below it in column H), or
H5 goes to orange (some data in a cell in Column H below H5.

If you move down the column from H8, to say H9 then
A8:D8 go clear, A9:D9 turn Red along with H9, no change in H5 (still red)

Question #1: Is it not working that way?
Question #2: could you describe your desired operation kind of like how I
did just now, giving examples of what should happen to which cells as you
move around?


"Ed" wrote:

Hello and thanks a lot for this very long impressive code! It happy with it
and it works perfectly for my purpose, but I would like to know if it is
possible to make a change with the "Orange" highlighted cells. In this
particular file that you sent me, it would be great if the orange "titles"
would be highligted just for the current row rather than the entire column.
For example, if my active cell is in Row 6, there are none orange titles, if
I move to Row 7, title N$5 is highlighted orange, then Row 8 nothing again,
and Row 9 G$5 and so on... If I would have severl entries in a row then those
corresponding titles would be highlighted, I don't really know but it is
hard to program or if it will take lots of time with all that checking it has
to do... thanks again!


"JLatham" wrote:

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!