This might not work because RGB(120,120,120) will map to RGB(128,128,128) in
Excel, unless you have a custom colour


Public Sub ProcessData()
Const TEST_COLUMN As String = "A" '<=== change to suit
Dim i As Long
Dim iLastRow As Long
Dim rng As Range
Dim ColorValue As Long

With ActiveSheet

ColorValue = 120 + 120 * 256 + 120 * 256 ^ 2
iLastRow = .Cells(.Rows.Count, TEST_COLUMN).End(xlUp).Row
For i = 1 To iLastRow
If .Cells(i, TEST_COLUMN).Interior.Color = ColorValue Then
If rng Is Nothing Then
Set rng = .Cells(i, TEST_COLUMN)
Else
Set rng = Union(rng, .Cells(i, TEST_COLUMN))
End If
End If
Next i

If Not rng Is Nothing Then
rng.EntireRow.Copy .Cells(iLastRow + 1, TEST_COLUMN)
rng.EntireRow.Delete
End If
End With

End Sub

--
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my addy)

"Cato Larsen" wrote in message
...
Hey!
I've gotten a request from a user to program a VB macro that moves all
rows
in a spreadsheet to the bottom if it contains a color (rgb(120,120,120))
I've been google'ing like nuts, but I've yet to find a solution that fits
the task.

As I've set it up right now its basicly something like this:

' Do a quick loop to find the bottom:
Do
iCounter = iCounter + 1
Loop Untill Cells(iCounter, 1).Value = ""

' Copy bottom interget into correct variable
iBottom = iCounter

' Set iCounter to first row below header.
iCounter = 2

Pseudocode for what I need:
loop while iCounter < iBottom
if currentRow.BackgroundColor = Grey
swap currentRow with Row(iBottom)
iBottom - 1
else iCounter + 1
end if
loop end

Can anyone help me out?
--
Cato Larsen
HelpDesk Monkey