Find formatted cells

  • Thread starter Thread starter Jim Mills
  • Start date Start date
J

Jim Mills

Hi
Is there a way in VBA to scan a range of cells and pick up the references of
any cells that have a particular format applied? The range may have more
than one cell with the format applied and I want to be able to use the
references elsewhere in the workbook.

Many thanks.
Jim
 
xl2002 added the ability to find by format.

Before that you could have a macro that would search through your sheets looking
for cells that match a specific format.

But there are lots of things that are in the format of the cell. If you limit
your search criteria (font/boldness/fill color/font color), you may even get a
few posts that can help.
 
Dave

Thanks. I'm looking to find some code to scan the range looking for cells
with a backgound colour set, collect the cell reference(s). I want then to
try and apply the formatting to a similar range on a different sheet but I
can probably do that (!) if I can get some help with the first part.

Jim.
 
I'm kind of confused, but maybe this will help:

Option Explicit
Sub testme()
Dim myBaseCell As Range
Dim myCell As Range
Dim myRng As Range
Dim myColorIndex As Long

Set myBaseCell = Nothing
On Error Resume Next
Set myBaseCell = Application.InputBox(Prompt:="select your cell", _
Type:=8).Cells(1)
On Error GoTo 0

If myBaseCell Is Nothing Then
Exit Sub 'user hit cancel
End If

myColorIndex = myBaseCell.Interior.ColorIndex

For Each myCell In Worksheets("sheet1").UsedRange
If myCell.Interior.ColorIndex = myColorIndex Then
If myRng Is Nothing Then
Set myRng = myCell
Else
Set myRng = Union(myCell, myRng)
End If
End If
Next myCell

If myRng Is Nothing Then
MsgBox "No cells found"
Else
MsgBox "Found here: " & myRng.Address(0, 0)
End If

End Sub
 
Dave
Perfect, very many thanks.

Jim


Dave Peterson said:
I'm kind of confused, but maybe this will help:

Option Explicit
Sub testme()
Dim myBaseCell As Range
Dim myCell As Range
Dim myRng As Range
Dim myColorIndex As Long

Set myBaseCell = Nothing
On Error Resume Next
Set myBaseCell = Application.InputBox(Prompt:="select your cell", _
Type:=8).Cells(1)
On Error GoTo 0

If myBaseCell Is Nothing Then
Exit Sub 'user hit cancel
End If

myColorIndex = myBaseCell.Interior.ColorIndex

For Each myCell In Worksheets("sheet1").UsedRange
If myCell.Interior.ColorIndex = myColorIndex Then
If myRng Is Nothing Then
Set myRng = myCell
Else
Set myRng = Union(myCell, myRng)
End If
End If
Next myCell

If myRng Is Nothing Then
MsgBox "No cells found"
Else
MsgBox "Found here: " & myRng.Address(0, 0)
End If

End Sub
Click to expand...
 
Back
Top