Shade col. up to used cell

[Piranha]

Hi,
Range - "MyNamedRange"
Rows with data and blank cells

Goal:

From last used row in range, (with data in row),
going up, shade cells in columns, only untill a cell with data
Would look kinda like a bar graph showing how long, rows have not had
data.
A B C D E
h, r, , f, a
i, y, , , b
p, , l, , g
t, , , , t

So
B3,B4
C4
D2,D3,D4
Would be shaded untill new data was added

Now don't laugh but this is what i am working on (no it dont work)

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Address = "MyNamedRange"
Cells.Borders().LineStyle = xlNone
Cells.Interior.ColorIndex = 0
LastRow = .Cells(.Rows.Count, "A:AP").End(xlUp).Row
..Interior.ColorIndex = 36
End If
End Sub


Thx
Dave

 

[Norman Jones]

Hi Dave,

Try putting the following in a normal module in the workbook in question:

Sub Initialize()

Dim rng As Range

Range("MyNamedRange").Cells.Interior.ColorIndex _
= xlNone

On Error Resume Next
Set rng = Range("MyNamedRange").SpecialCells(xlBlanks)
On Error GoTo 0

If Not rng Is Nothing Then
rng.Interior.ColorIndex = 36
End If

End Sub

Then paste the following into the worksheet code module:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng1 As Range
Dim rng2 As Range
Dim rCell As Range

Set rng1 = Range("MyNamedRange")
Set rng2 = Intersect(Target, rng1)

If Not rng2 Is Nothing Then
For Each rCell In rng2
If IsEmpty(rCell) Then
rCell.Interior.ColorIndex = 36
Else
rCell.Interior.ColorIndex = xlNone
End If
Next
End If
End Sub

 

[Norman Jones]

Hi Dave,

To add, run the Initialize sub first.

 

[Piranha]

Hi Norman,

Thank you very much for responding.
Your Macro works very well, but it highlights every unused cell in the
entire range.
I am looking to Start highlighting at the last used row and go up to
the last used cell
in each column (which is different in each column).

So there would be nothing below the last used row and when the shading
is going up,
it will stop when it hits a used cell

Make sense??
Dave

 

[Norman Jones]

Hi Dave,

Here are two subs which replace all previous code.

Paste the first PseudoBarChart sub into a standard module in your workbook;
paste the Worksheet_Change event code into the worksheet module.

In the PseudoBarChart sub, replace, "MyNamedRange" with your range name.

'=============================>>
Sub PseudoBarChart()
Dim WS As Worksheet
Dim bigRng As Range
Dim rng As Range
Dim rCell As Range
Dim RngShade As Range
Dim iCol As Long, Lrow As Long, rw As Long

Application.ScreenUpdating = False
Set WS = ActiveSheet
Set bigRng = WS.Range("MyNamedRange")

bigRng.Interior.ColorIndex = 15

Lrow = LastRow(WS, bigRng)

For Each rng In bigRng.Columns
iCol = rng.Column
rw = Cells(Rows.Count, iCol).End(xlUp).Row

Set rCell = Cells(rw, iCol)

rw = IIf(IsEmpty(rCell), rw, rw + 1)

If rw <= Lrow Then
Range(Cells(rw, iCol), Cells(Lrow, iCol)). _
Interior.ColorIndex = 36
End If

Next

If Not RngShade Is Nothing Then _
RngShade.Interior.ColorIndex = 36

Application.ScreenUpdating = True
End Sub

'<<=============================

'=============================>>
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng1 As Range
Dim rng2 As Range

Set rng1 = Range("MyNamedRange")
Set rng2 = Intersect(Target, rng1)

If Not rng2 Is Nothing Then _
Call PseudoBarChart

End Sub
'<<=============================

 

[Piranha]

Hi Norman,
On the "Sub PseudoBarChart()"
I'm getting a "sub or function not defined"

And the word "LastRow" in this line is highlighted dark blue

Lrow = LastRow(WS, bigRng)

Thx for all this time and help.
Dave

 

[Norman Jones]

Hi Piranha,

My fault, I forgot to include a function which needs to be posted into the
standard module together with the PseudoBarChart sub:

Function LastRow(sh As Worksheet, rng As Range)
On Error Resume Next
LastRow = rng.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function

 

[Piranha]

Norman,

Your second soultion works with the function, But it still dosen't meet
my criteria.
It shades ALL cells in "MyNamedRange"

I think i will just continue to do this task manually every day as i
have been doing,
instead of trying to automate it.

Your help and time is Very Much Appricated.
Thx
Dave

 

[Norman Jones]

Hi Dave,

The code works for me.

If you would like a copy of my test book,you can contact me at:

(replace dot and remove each X) :

nXorman_jXones@btXinternetDOTcom

 

[Piranha]

Norman,

Your solution to this is perfect. You are amazing.

Thank You Very Very much

Dave