Select a range based on Fill Color

[Jonathan Brown]

I need to select a range starting from the cell above the activecell and
continuing upward and stopping when it finds the first cell that contains a
fill color. In other words, I need to select the first group of cells above
the active cell that all have "no fill" as their fill color.

I then want to take that range and plug it into the =COUNTA() formula for
the activecell. But first I just want to find the range, I'll worry about
the formula later.

Here's what I've written so far which doesn't seem to be working:

Private Sub CommandButton1_Click()

Dim StartCell As Range

Set StartCell = ActiveCell

Do While ActiveCell.Interior.ColorIndex = xlColorIndexNone
Range(StartCell & ":" & ActiveCell.Offset(-1, 0)).Select
Loop

End Sub

Anybody have an idea on how to do this?

 

[Barb Reinhardt]

I think I'd try this

Private Sub CommandButton1_Click()

Dim StartCell As Range
Dim myRange As Range
Dim myNewRange As Range

Set StartCell = ActiveCell
Set myRange = Nothing
Set myRange = StartCell.Offset(1 - StartCell.Row, 0).Resize(StartCell.Row, 1)
Debug.Print StartCell.Address, myRange.Address

Set myNewRange = Nothing

For i = myRange.Rows.Count To 1 Step -1
If myRange.Cells(i).Interior.ColorIndex = xlColorIndexNone Then
If myNewRange Is Nothing Then
Set myNewRange = myRange.Cells(i)
Else
Set myNewRange = Union(myRange.Cells(i), myNewRange)
End If
Else
Exit For
End If
Next i

Debug.Print myNewRange.Address

End Sub

 

[JLGWhiz]

Hi Barb, Just a side note. If the cell color is set by conditional format,
this code fails.

 

[Jonathan Brown]

Barb,

This is very good. There is one problem I'm having with it. It's including
the active cell as part of the range as well, which is causing a circular
reference in my formula. I think this is because the active cell has no fill
as well. If I change the active cell to include a fill color and run it I
then get a "Run-time error '91': Object Variable or With block variable not
set" and it highlights the debug.print myNewRange.Address line.

How do I prevent it from including the active cell?

 

[Jonathan Brown]

Does anybody know of another way to do this?

Barb,

This is very good. There is one problem I'm having with it. It's including
the active cell as part of the range as well, which is causing a circular
reference in my formula. I think this is because the active cell has no fill
as well. If I change the active cell to include a fill color and run it I
then get a "Run-time error '91': Object Variable or With block variable not
set" and it highlights the debug.print myNewRange.Address line.

How do I prevent it from including the active cell?

 

[Dave Peterson]

Option Explicit
Private Sub CommandButton1_Click()

Dim iRow As Long
Dim ThisCol As Long
Dim myRng As Range

Set myRng = Nothing
If ActiveCell.Row = 1 Then
'do nothing
Else
ThisCol = ActiveCell.Column

With Me
For iRow = ActiveCell.Row - 1 To 1 Step -1
If .Cells(iRow, ThisCol).Interior.ColorIndex _
= xlColorIndexNone Then
If myRng Is Nothing Then
Set myRng = .Cells(iRow, ThisCol)
Else
Set myRng = Union(.Cells(iRow, ThisCol), myRng)
End If
Else
'get out
Exit For
End If
Next iRow
End With

End If

If myRng Is Nothing Then
ActiveCell.Value = 0
Else
ActiveCell.Value = Application.CountA(myRng)
'or if you want the formula
'ActiveCell.Formula = "=counta(" & myRng.Address(0, 0) & ")"
End If

End Sub

 

[Bthoron]

I need something similar except that I'd like to only select the cells with
in a given range which matched the color of the current cell.
This example counted only the cells above the current one that weren't
filled. I sort of need the opposite.

Can anybody help?

Thanks very much.

Ben

 

[Dave Peterson]

This still runs from a commandbutton placed on a worksheet.

You have to supply the given range's address and select the correct starting
cell:

Option Explicit
Private Sub CommandButton1_Click()

Dim myRng As Range
Dim GivenRng As Range
Dim ActCell As Range
Dim myCell As Range

Set ActCell = ActiveCell

With Me
'what's the given range?
Set GivenRng = .Range("a1:ai9")
Set GivenRng = Intersect(.UsedRange, GivenRng)
If GivenRng Is Nothing Then
MsgBox "Given Range is not in the usedrange!"
Exit Sub
End If

Set myRng = Nothing

For Each myCell In GivenRng.Cells
If myCell.Interior.ColorIndex = ActCell.Interior.ColorIndex Then
If myRng Is Nothing Then
Set myRng = myCell
Else
Set myRng = Union(myCell, myRng)
End If
End If
Next myCell
End With

If myRng Is Nothing Then
MsgBox "nothing found to select"
Else
myRng.Select
End If

End Sub

 

[Bthoron]

When I copied this into a Module, the compiler tripped on the "With Me"
statement.
"invalid use of Me Keyword".

Any thoughts?
I'm running 2003.

Thanks
Ben

 

[Dave Peterson]

How are you invoking the macro?

If you're using a commandbutton from the Control toolbox toolbar (placed on a
worksheet), then the code doesn't belong in a general module.

If you're not doing that, try:

With ActiveSheet