Hi,

Try this. I've included the code to add the borders but you can delete this
if you want to do it manually. Not this will not work for conditionally
formatted coloured cells

Sub sonic()
Dim CopyRange As Range
For Each c In ActiveSheet.UsedRange
If c.Interior.ColorIndex < xlNone Then
If CopyRange Is Nothing Then
Set CopyRange = c
Else
Set CopyRange = Union(CopyRange, c)
End If
End If
Next

CopyRange.Select

'delete from here to end
'if you want to do the border manually

With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.Weight = xlMedium
End With
End Sub
--
Mike

When competing hypotheses are otherwise equal, adopt the hypothesis that
introduces the fewest assumptions while still sufficiently answering the
question.


"slb0927" wrote:

Need help writing the code for an Excel Macro that would find all cells that
have any interior color so that an outer border can be added around all
colored cells.