View Single Post
  #5   Report Post  
Posted to microsoft.public.excel.programming
Norman Jones Norman Jones is offline
external usenet poster
 
Posts: 5,302
Default Shade col. up to used cell

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


---
Regards,
Norman



"Piranha" wrote in
message ...

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 Wrote:
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
'<<=============================


---
Regards,
Norman



"Piranha" wrote
in
message ...

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



--
Piranha
------------------------------------------------------------------------
Piranha's Profile:
http://www.excelforum.com/member.php...o&userid=20435
View this thread: http://www.excelforum.com/showthread...hreadid=383760