Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
sort cells by color ?Macro?
Hi everybody! I have a pretty messed up but COLORED table. Now I would like to put the CELLS WITHIN A ROW into the right order. Since each cell in a row has a specific color it's no problem - thats what I thought...!!! :-( Here's the scheme: Each row has 3-6 cells, all in a different color. Now, I would like to have these cells in a specific order: white, yellow, green, blue, black, red - so that I end up having in each column only one color. BUT in some rows some of those colors might be missing, that's why I actually don´t think a sorting function would really help. If a color is missing, then their should just be a blank in the colored column. Here's an example-file: http://www.herber.de/bbs/user/31944.xls I guess, it must be something like a macro that doesn't sort, but COPIES the colored cells of a row into the specified column [each color goes to an according column] so that it ends up with a column of red cells, a column of white cells, and so on... Here's an example-file: http://www.herber.de/bbs/user/31944.xls I am not good with VBA, I tried to record some macros and manipulate them, but I never reached anything usefull. :( Can anybody give me some hints?????? THANKS SO MUCH FOR TAKING THE TIME!!! -- JVLennox ------------------------------------------------------------------------ JVLennox's Profile: http://www.excelforum.com/member.php...o&userid=32505 View this thread: http://www.excelforum.com/showthread...hreadid=522938 |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
sort cells by color ?Macro?
Hi JVLennox,
this worked for me, but where did that extra green cell come from? Public Sub ColorSort() Dim iLastRow As Long Dim iFirstRow As Long Dim iLastColumn As Long Dim iFirstColumn As Long Dim iRowCounter As Long Dim iColumnCounter As Integer Dim rgColorRange As Range Dim iWhiteColumns1 As Integer Dim iYellowColumns1 As Integer Dim iGreenColumns1 As Integer Dim iBlueColumns1 As Integer Dim iBrownColumns1 As Integer Dim iRedColumns1 As Integer Dim iWhiteColumns2 As Integer Dim iYellowColumns2 As Integer Dim iGreenColumns2 As Integer Dim iBlueColumns2 As Integer Dim iBrownColumns2 As Integer Dim iRedColumns2 As Integer Dim iWhitePaste As Integer Dim iYellowPaste As Integer Dim iGreenPaste As Integer Dim iBluePaste As Integer Dim iBrownPaste As Integer Dim iRedPaste As Integer Dim iFinalNumColumns As Integer Dim iLastWhiteCol As Integer Dim iLastYellowCol As Integer Dim iLastGreenCol As Integer Dim iLastBlueCol As Integer Dim iLastBrownCol As Integer Dim iLastRedCol As Integer Set rgColorRange = Application.InputBox( _ Prompt:="Please select the colored cells", _ Default:=Selection.Address, _ Type:=8) iFirstRow = rgColorRange.Row iLastRow = iFirstRow + rgColorRange.Rows.Count - 1 iFirstColumn = rgColorRange.Column iLastColumn = iFirstColumn + rgColorRange.Columns.Count - 1 For iRowCounter = iFirstRow To iLastRow iWhiteColumns1 = 0: iYellowColumns1 = 0: iGreenColumns1 = 0 iBlueColumns1 = 0: iBrownColumns1 = 0: iRedColumns1 = 0 For iColumnCounter = iFirstColumn To iLastColumn Select Case Cells(iRowCounter, iColumnCounter) _ ..Interior.ColorIndex Case -4142 If Cells(iRowCounter, iColumnCounter).Value < "" Then iWhiteColumns1 = iWhiteColumns1 + 1 End If Case 6 iYellowColumns1 = iYellowColumns1 + 1 Case 4 iGreenColumns1 = iGreenColumns1 + 1 Case 5 iBlueColumns1 = iBlueColumns1 + 1 Case 53 iBrownColumns1 = iBrownColumns1 + 1 Case 3 iRedColumns1 = iRedColumns1 + 1 End Select If iWhiteColumns1 iWhiteColumns2 Then Let iWhiteColumns2 = iWhiteColumns1 End If If iYellowColumns1 iYellowColumns2 Then Let iYellowColumns2 = iYellowColumns1 End If If iGreenColumns1 iGreenColumns2 Then Let iGreenColumns2 = iGreenColumns1 End If If iBlueColumns1 iBlueColumns2 Then Let iBlueColumns2 = iBlueColumns1 End If If iBrownColumns1 iBrownColumns2 Then Let iBrownColumns2 = iBrownColumns1 End If If iRedColumns1 iRedColumns2 Then Let iRedColumns2 = iRedColumns1 End If Next Next iLastWhiteCol = iFirstColumn + iWhiteColumns2 iLastYellowCol = iLastWhiteCol + iYellowColumns2 iLastGreenCol = iLastYellowCol + iGreenColumns2 iLastBlueCol = iLastGreenCol + iBlueColumns2 iLastBrownCol = iLastBlueCol + iBrownColumns2 iLastRedCol = iLastBrownCol + iRedColumns2 iFinalNumColumns = iLastRedCol _ - iFirstColumn + 1 For iRowCounter = iLastRow To iFirstRow Step -1 With Range(Cells(iRowCounter, 1), _ Cells(iRowCounter, iLastColumn)) .Insert Shift:=xlDown .Offset(-1, 0).Clear End With iWhitePaste = 0: iYellowPaste = 0: iGreenPaste = 0 iBluePaste = 0: iBrownPaste = 0: iRedPaste = 0 For iColumnCounter = iFirstColumn To iLastColumn Select Case Cells(iRowCounter + 1, iColumnCounter) _ ..Interior.ColorIndex Case -4142 If Cells(iRowCounter + 1, iColumnCounter).Value < "" Then Cells(iRowCounter + 1, iColumnCounter) _ ..Copy Cells(iRowCounter, iFirstColumn + iWhitePaste) iWhitePaste = iWhitePaste + 1 End If Case 6 Cells(iRowCounter + 1, iColumnCounter) _ ..Copy Cells(iRowCounter, iWhiteColumns2 + 1 + iYellowPaste) iYellowPaste = iYellowPaste + 1 Case 4 Cells(iRowCounter + 1, iColumnCounter) _ ..Copy Cells(iRowCounter, iWhiteColumns2 + iYellowColumns2 _ + 1 + iGreenPaste) iGreenPaste = iGreenPaste + 1 Case 5 Cells(iRowCounter + 1, iColumnCounter) _ ..Copy Cells(iRowCounter, iWhiteColumns2 + iYellowColumns2 _ + iGreenColumns2 + 1 + iBluePaste) iBluePaste = iBluePaste + 1 Case 53 Cells(iRowCounter + 1, iColumnCounter) _ ..Copy Cells(iRowCounter, iWhiteColumns2 + iYellowColumns2 _ + iGreenColumns2 + iBlueColumns2 + 1 + iBrownPaste) iBrownPaste = iBrownPaste + 1 Case 3 Cells(iRowCounter + 1, iColumnCounter) _ ..Copy Cells(iRowCounter, iWhiteColumns2 + iYellowColumns2 _ + iGreenColumns2 + iBlueColumns2 + iBrownColumns2 + 1 _ + iRedPaste) iRedPaste = iRedPaste + 1 End Select Next Range(Cells(iRowCounter + 1, 1), _ Cells(iRowCounter + 1, iLastColumn)).Delete Shift:=xlUp Next Range(Cells(iFirstRow, iFirstColumn), Cells(iFirstRow, _ iLastColumn + iFinalNumColumns - 1)).Insert Shift:=xlDown Range(Cells(iFirstRow, iFirstColumn), _ Cells(iFirstRow, iLastWhiteCol - 1)).Value = "WEISS" Range(Cells(iFirstRow, iLastWhiteCol), _ Cells(iFirstRow, iLastYellowCol - 1)).Value = "GELB" Range(Cells(iFirstRow, iLastYellowCol), _ Cells(iFirstRow, iLastGreenCol - 1)).Value = "GRÜN" Range(Cells(iFirstRow, iLastGreenCol), _ Cells(iFirstRow, iLastBlueCol - 1)).Value = "BLAU" Range(Cells(iFirstRow, iLastBlueCol), _ Cells(iFirstRow, iLastBrownCol - 1)).Value = "BRAUN" Range(Cells(iFirstRow, iLastBrownCol), _ Cells(iFirstRow, iLastRedCol - 1)).Value = "ROT" Range(Cells(iFirstRow, iFirstColumn), Cells(iFirstRow, _ iLastRedCol)).Font.Bold = True End Sub Ken Johnson |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
sort cells by color ?Macro?
Hey Ken, thanks a lot! BUT I always get a Syntax error in the Editor for the "3D" in you code...??? Where does that come from? Thanks so much! @ Pete: I'll try sending him an email -- JVLenno ----------------------------------------------------------------------- JVLennox's Profile: http://www.excelforum.com/member.php...fo&userid=3250 View this thread: http://www.excelforum.com/showthread.php?threadid=52293 |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
sort cells by color ?Macro?
Hi JV,
What is the "3D"? Which line produces the error? I copied the code from above then pasted it into a new workbook and it worked fine. Ken Johnson |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
sort cells by color ?Macro?
I think the added "3D" is a problem with some web-based newsgroup hosts
(such as the one JV is using). Tim "Ken Johnson" wrote in message ups.com... Hi JV, What is the "3D"? Which line produces the error? I copied the code from above then pasted it into a new workbook and it worked fine. Ken Johnson |
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
sort cells by color ?Macro?
Hi Tim
thanks for that. I wonder, is there is a simple solution. Would emailing the code an option? Ken Johnson |
#8
Posted to microsoft.public.excel.programming
|
|||
|
|||
sort cells by color ?Macro?
I guess so. But many posters don't include a valid e-mail.
Tim "Ken Johnson" wrote in message oups.com... Hi Tim thanks for that. I wonder, is there is a simple solution. Would emailing the code an option? Ken Johnson |
#9
Posted to microsoft.public.excel.programming
|
|||
|
|||
sort cells by color ?Macro?
Thanks again Tim.
JV's probably better served by Jim Cone's addin, which I'm sure would better tested than my verbose code, so I'll just wait and see. Ken Johnson |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Sort by color: Is there an easy way to sort columns or rows in EX | Excel Worksheet Functions | |||
How do I sort or count cells by fill color? | Excel Discussion (Misc queries) | |||
Can I sort excel spreadsheet data by fill color of cells? | Excel Discussion (Misc queries) | |||
Can you sort excel data by color coded cells? | Excel Discussion (Misc queries) | |||
Excel sort by Fill Color by custom list sort | Excel Discussion (Misc queries) |