ExcelBanter - search excel for cells with a color

How about a macro?

Option Explicit
Sub testme()

Dim CurWks As Worksheet
Dim RptWks As Worksheet

Dim FoundCell As Range
Dim destCell As Range
Dim FirstAddress As String

Application.FindFormat.Clear
With Application.FindFormat.Interior
.ColorIndex = 6 'whatever you want here!
End With

Set CurWks = Worksheets("sheet1")
Set RptWks = Worksheets.Add

Set destCell = RptWks.Range("a1")

With CurWks.UsedRange
Set FoundCell = .Cells.Find(What:="", _
After:=.Cells(.Cells.Count), _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=True)
If FoundCell Is Nothing Then
'do nothing
MsgBox "not found!"
Else
FirstAddress = FoundCell.Address
Do
FoundCell.Copy _
Destination:=destCell
destCell.Offset(0, 1).Value = FoundCell.Address(0, 0)
Set destCell = destCell.Offset(1, 0)

Set FoundCell = .Cells.Find(What:="", _
After:=FoundCell, _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=True)
Loop While Not FoundCell Is Nothing _
And FoundCell.Address < FirstAddress
End If
End With
End Sub

The .findnext() stuff seemed to forget about the searchformat parm.

If you're new to macros, you may want to read David McRitchie's intro at:
http://www.mvps.org/dmcritchie/excel/getstarted.htm

john mcmichael wrote:

I am trying to run a search for all cells in a spreadsheet that have a
specific background color. The good news is I can do it and view the list of
all formatted cells. I would like to then copy the contents of these cells
and place them on another sheet. However, I am having trouble copying the
contents and moving them. Can anyone provide any suggestions?

Thanks

--

Dave Peterson