Prev: Advanced transpose/grouping question
Next: eliminating unwanted data
From: slb0927 on 31 Jan 2010 14:06
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.
From: Mike H on 31 Jan 2010 14:23
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.
From: Master Blaster on 31 Jan 2010 14:38
On Jan 31, 8:06 pm, slb0927 <slb0...(a)discussions.microsoft.com> 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.

If you adjust the range than the code below is simple and works.

Sub Select_Colored_Cells()

For r = 1 To 30
For k = 1 To 30

If Cells(r, k).Interior.ColorIndex <> xlNone Then
Cells(r, k).Select
Selection.Borders(xlEdgeLeft).LineStyle = xlContinuous
Selection.Borders(xlEdgeTop).LineStyle = xlContinuous
Selection.Borders(xlEdgeBottom).LineStyle = xlContinuous
Selection.Borders(xlEdgeRight).LineStyle = xlContinuous
End If

Next k
Next r
End Sub
 | 
Pages: 1
Prev: Advanced transpose/grouping question
Next: eliminating unwanted data