Sub SelectByColor()
 On Error Resume Next
 Application.ScreenUpdating = False
 Dim c As Range
 Dim r As Long
 Dim myArea As Range
 Dim myRange As Range
 Set myArea = ActiveSheet.UsedRange
 For Each c In myArea
  If c.Interior.ColorIndex = ActiveCell.Interior.ColorIndex Then
   If r = 0 Then
    Set myRange = c
    r = 1
   Else
    Set myRange = Union(myRange, c)
   End If
  End If
 Next c
 myRange.Select
 Application.ScreenUpdating = True
End Sub