Excel Heiarchy and Highlight rows where certain data lies

  • Thread starter Thread starter BZeyger
  • Start date Start date
B

BZeyger

Hello,

I am working on a macro and I do know how to go about it. I am just getting
started with macro's.
I have an excel sheet that is laid out as a heiarchy chart.

Example:

A B C D

Bob
Gym
13 Years
Senior

I would like to highlight the rows that contain data in COL A one Color, The
rows that contain data in COL B another color, etc.

How can this be coded?
 
This has a Mod statement in it that checks to see if the range is divisible
by four. If not it will exit the sub without executing the color scheme.
You can delete that line if you do not want the range to be exactly
divisible by four. I used the color index for red, green, blue and yellow
in the myArr array. You can change those to suit your purposes.

Sub fourColr()
Dim sh As Worksheet, rng As Range, myArr As Variant
Set sh = ActiveSheet
Set rng = Range("A1:A20") '<<<Set actual range
x = rng.Rows.Count
If x Mod 4 > 0 Then Exit Sub '<<<Dele this line if not desired
myArr = Array(3, 4, 5, 6) '<<<Change ColorIndex here
For i = 1 To x Step 4

If i < 5 Then
y = 1
Else
y = i
End If
z = 0
Do Until y = i + 4
sh.Rows(Cells(y, 1).Row).Interior.ColorIndex = myArr(z)
y = y + 1
z = z + 1
Loop
Next
End Sub
 
Thanks for the response, but this wasn't exactly what I was looking for.

Lets say we have

A B C D

1 John
2 Hands
3 Feet
4 13
5 15
6 19
7 Sister
8 Max
9 Ears
10 15
11 16
12 Brother
13 Sister


The rows are going to be populated from an external source. I would like to
highlight the rows that contain data in COL A one color, the rows that
contain data in COL 2 another color, etc.

It is not a set patern.

Thanks again for your input.
 
You can put this code into the ThisWorkbook code module as a Workbook_Open
event code and it will run each time you open the workbook. you would have
to substitute the actual sheet name where ActiveSheet now appears, i.e. Set
sh = Sheets("Sheet1").
The title line would appear as :

Private Sub Workbook_Open()
'The code here
End Sub

Or you can put it in the worksheet where the data is loaded as a
Worksheet_Change event code and it will run each time a change is made to
the worksheet so that any additions or indenture changes are updated in real
time. The title line for this would appear as:

Private Sub Worksheet_Change(ByVal Target As Range)
'you would probably want to insert this line of code as the first line.
If Intersect(Target, Range("A:D") ) Is Nothing Then Exit Sub
'The rest of the code here
End Sub

Dim sh As Worksheet, rng As Range, myArr As Variant
Dim lr As Long
Set sh = ActiveSheet
lr = sh.Cells.Find(What:="*", After:=sh.Range("A1"), LookAt:=xlPart, _
LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, _
MatchCase:=False).Row
Set rng = Range("A1:A" & lr) '<<<Set actual range
For Each c In rng
If WorksheetFunction.CountA(sh.Range(c.Address, _
c.Offset(0, 2))) = 0 Then
Rows(c.Row).Interior.ColorIndex = 3
ElseIf WorksheetFunction.CountA(sh.Range(c.Address, _
c.Offset(0, 1))) = 0 Then
Rows(c.Row).Interior.ColorIndex = 4
ElseIf WorksheetFunction.CountA(c) = 0 Then
Rows(c.Row).Interior.ColorIndex = 5
ElseIf Not IsEmpty(c) Then
Rows(c.Row).Interior.ColorIndex = 6
End If
Next


This will work for Indenture A through D. If you need more than that, you
can play with the code by adding additional ElseIf lines and extending the
offset range to cover more blank cells on a row.
 
Back
Top