Moving rows with grey background color to bottom (2003)

[Guest]

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?

 

[Bob Phillips]

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)

 

[Guest]

Sub movegray()

LastRow = Cells(Rows.Count, "A").End(xlUp).Row
BottomRow = LastRow + 1
RowCount = LastRow
Do While RowCount > 0
For ColumnCount = 1 To Columns.Count
If Cells(RowCount, ColumnCount).Interior.Color = grey Then
Rows(RowCount).Copy
Rows(BottomRow).Insert
Rows(RowCount).Delete
BottomRow = BottomRow - 1
Exit For
End If
Next ColumnCount
RowCount = RowCount - 1
Loop
End Sub

 

[paul.robinson]

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?

Hi
Create this function

Function RowColour(myRange As Range) As Long
RowColour = myRange.Interior.ColorIndex
End Function

In Excel, your user can go to the first row in the data, the next
empty column and type in = RowColour. They will be prompted for the
cell and they just click on the cell to the left.
Now fill this formula down and sort the data columns by this column.
This method will sort multicoloured lists too.
If they want this formula on any workbook, simply put the macro in the
file personal.xls
regards
Paul

 

[Guest]

Thank you for your reply Bob, but it was a bit overly complicated.
I've found out how to find the row with the correct bg color, I just need to
know how to move the row to the bottom. I also know where the bottom is, so
detection loops for this isnt really required in this answer.

I would think that this is the part of the code that does the moving trick:
---
rng.EntireRow.Copy .Cells(iLastRow + 1, TEST_COLUMN)
rng.EntireRow.Delete
---
So I modified this code to fit the stuff I'd already written and it works
like a charm!

Kudos to ya!

Cheers!

--
Cato Larsen
HelpDesk Monkey


<-SNIP->