View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.misc
Dave Peterson Dave Peterson is offline
external usenet poster
 
Posts: 35,218
Default Sort range by color

With only about 600 rows to process, is there a reason you don't just delete the
rows you don't want based on colorindex of that cell?

Option Explicit
Sub MySortingMacro2()

Dim iRow As Long
Dim OldCalc As Long
Dim wks As Worksheet
Dim ViewMode As Long

Set wks = Worksheets("sheet1")

With Application
OldCalc = .Calculation
.Calculation = xlManual
.ScreenUpdating = False
End With

ViewMode = ActiveWindow.View
ActiveWindow.View = xlNormalView

With wks
.DisplayPageBreaks = False
For iRow = 600 To 6 Step -1
'6 is bright yellow in my test workbook
If .Cells(iRow, "D").Interior.ColorIndex = 6 Then
.Rows(iRow).Delete
End If
Next iRow
End With

With Application
.Calculation = OldCalc
.ScreenUpdating = True
End With
ActiveWindow.View = ViewMode

End Sub

wrote:

Hey everyone!

I need to sort a range of cells (A6:H600) by interior color. I've
found some code that will sort the entire page, but I need to sort just
the range. There are only cells with a color index of 6 (yellow) and
all the rest are white. So all I need to do is have the yellow cells
show up at the top of the range, and then I'll delete the rest. This
is what I found that works for the whole worksheet:

Sub MySortingMacro()
'Based on Bernard Rey's routine
Const ISHEADER As Long = xlNo ' or xlYes or xlGuess
Dim cell As Range
Dim oldCalc As Long

With Application
oldCalc = .Calculation
.Calculation = xlManual
.ScreenUpdating = False
End With
With Selection(1) 'I changed this line to: With Range("D7")
With .EntireColumn
Columns(.Column).Insert ' Adding a temporary column
For Each cell In Intersect(.Cells,
ActiveSheet.UsedRange)
cell.Offset(0, -1).Value = cell.Interior.ColorIndex

Next cell
End With
.Sort Key1:=.Offset(0, -1), Order1:=xlAscending, _
header:=ISHEADER
.Offset(0, -1).EntireColumn.Delete
End With
With Application
.Calculation = oldCalc
.ScreenUpdating = True
End With
End Sub

I've seen lots of other topics on this, but nothing that will work with
a specific range. Do I just need to change the line 'With Range("D7")'
to something else?


--

Dave Peterson