Sort by rows left to right based on cell font color

[naturally_data]

Hi,

Hoping for some help please. I need to be able to sort by row based on the font color of the cell content so that it is sorted left to right by color.
As in the example below, I'd like to sort the cell with red font to the left. I'd like each row to be sorted separately. I've used reecorded macro excel but that has not proven useful.
Regardless of where the data is located I want to be able to select the range I would like to be sorted. The most I've gotten is the VBA shown below. It is not working for me.
Thank you very much in advance for your kind help.

Sub sort_rows_left_to_right_by_color()
Dim wks As Worksheet
Dim rng As Range
Dim i As Long

Set wks = ActiveSheet
Set rng = Application.InputBox("Select range with the mouse", Type:=8)
If Not rng Is Nothing Then
With rng
For i = 1 To .Rows.Count
With .Rows(i)

With wks.Sort
With .SortFields
.Clear
.Add(Key:=.Rows(i).Range("A1")),xlSortOnFontColor, xlAscending, xlSortNormal).SortOnValue.Color = RGB(255, 0, 0)

End With
.Sort.Header = xlYes
.Sort.Orientation = xlLeftToRight
.Sort.Apply
End With
Next
End With
End Sub

#1 Column A	#2 Column B	#3 Column C	#4 Column D	#5 Column E	#6 Column F
1	2	3	4	5	6
10	11	19	67	99	76
00	00	23	32	55	78

 

[HighAndWilder]

Is there any logic as to why a cell is a particular color?

Is the color set manually or by using conditional formatting?

 

[naturally_data]

Hi HighAndWilder,

Thank you for looking into this for me. Very good questions. So, basically what is the ultimate goal you asked?
1) To have an ease of view way of seeing fulfilled orders for an item from a list which contains number of orders placed. Almost pictorially, I want to see orders fulfilled in red font sorted to the left and orders pending in normal black font to the right.
2) The font color is set manually when that order quantity is fulfilled.

3) At the end of the day I want to be able to visually see the orders fulfilled juxtaposed to those not fulfilled.

The result would appear something like this.
I may have over 50-100 rows like this and I'd like to sort quickly and not via the normal sorting method.

Thanks!

#1 Column A	#2 Column B	#3 Column C	#4 Column D	#5 Column E	#6 Column F
4​	6​	1​	2​	3​	5​
67​	76​	10​	11​	19​	99​
23​	32​	0​	0​	55​	78​

 

[HighAndWilder]

Can you set up a worksheet showing valid orders, proper column headings, colors and how you want to see the fulfilled and unfulfilled orders displayed and post an image.

This will give us a better idea of what you are aiming for.

 

[naturally_data]

Please see before and after example of the spreadsheet I am trying to use to keep track order orders fulfilled and not fulfilled.
I am trying to sort rows within E-J. I'd like it to be dynamic and not just hard coded to any range.

 

[HighAndWilder]

Place this in a code module and call the 'subRunCode' procedure from a macro.

It works on the active sheet so set up a test sheet.

To test that it works it populates the grid with random numbers and colors and then sorts it as you wanted.

Once you have confidence in how it works just call the 'subReorderColourCells' procedure from the macro.

It is not dynamic as colors are changed.

Let me know how you get on.

Public Sub subRunCode()
   
    ActiveWorkbook.Save
    
    Application.ScreenUpdating = True
    
    Call subReset

    Call subReorderColourCells

End Sub

Public Sub subReset()
Dim rngData As Range
Dim lngColor As Long
Dim rngCell As Range

            Range("E1").Select
            
            Application.ScreenUpdating = True
         
            Set rngData = Range("A1").Offset(1, 4).Resize(Range("A" & Rows.Count).End(xlUp).Row - 1, 6)
            
            With Range("E2:M12")
                .Clear
                .Font.Size = 14
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
            End With
            
            rngData.Borders.LineStyle = xlContinuous
            rngData.Offset(6, 0).Borders.LineStyle = xlContinuous
            
            ' Set the colours.
            For Each rngCell In rngData.Cells
                rngCell.Value = Int(1 + Rnd * (30 - 1 + 1))
                lngColor = Int(1 + Rnd * (2 - 1 + 1))
                rngCell.Font.Color = IIf(lngColor = 1, vbRed, 0)
                rngCell.Offset(6, 0) = rngCell.Value
                rngCell.Offset(6, 0).Font.Color = rngCell.Font.Color
            Next rngCell

            Range("L1:M6").Borders.LineStyle = xlContinuous

End Sub

Public Sub subReorderColourCells()
Dim rngData As Range
Dim i As Integer
Dim intRow As Integer
Dim rngCell As Range
Dim lngColor As Long
Dim rngRow As Range
Dim intValue As Integer
Dim rngCopy As Range
Dim rngPaste As Range
Dim intCurrent As Integer
Dim strCheck As String

        On Error GoTo Err_Handler
        
        Application.EnableEvents = False
        
        Set rngData = Range("F2:J6")
        
        For Each rngRow In rngData.Rows
        
            intRow = rngRow.Row
                        
            Do While True
                
                strCheck = ""
                For Each rngCell In rngRow.Offset(0, -1).Resize(1, 6).Cells
                    strCheck = strCheck & IIf(rngCell.Font.Color = 0, "B", "R")
                Next rngCell
                
                For i = 5 To 1 Step -1
                    
                    Range("L" & rngRow.Row & ":M" & rngRow.Row) = Array(6 - Len(Replace(strCheck, "R", "")), 6 - Len(Replace(strCheck, "B", "")))
                    
                    ' Check to see if there are any unfullfilled orders before fulfilled ones.
                    If InStr(1, strCheck, "BR", vbTextCompare) = 0 Then
                        Exit Do
                    End If
                    
                    Set rngCell = rngRow.Cells(1, i)
                  
                    If rngCell.Font.Color = vbRed Then
                        
                        intValue = rngCell.Value
                        Set rngCopy = Range("E" & rngCell.Row).Resize(1, IIf(i = 1, 1, i))
                        Set rngPaste = rngCopy.Offset(0, 1)
                        
                        Application.ScreenUpdating = False
                        rngCopy.Copy
                        rngPaste.PasteSpecial xlPasteFormats
                        Application.CutCopyMode = False
                        Range("E1").Select
                        rngPaste = rngCopy.Value
                            
                        Range("E" & intRow).Value = intValue
                        Range("E" & intRow).Font.Color = vbRed
                        
                        Application.ScreenUpdating = True
                        
                    End If ' If vbRed
                
                Next i  ' Next Cell in row - goes backwards.
                
            Loop
        
        Next rngRow
        
        MsgBox "Finished"
         
Exit_Handler:
    
        Application.EnableEvents = True
         
        Application.ScreenUpdating = True
        
        Exit Sub

Err_Handler:

    MsgBox Err.Number & "   " & Err.Description

    Resume Exit_Handler

End Sub

 

[naturally_data]

Hi HighAndWilder,

I am beyond bewilderment. You ARE awesome!!
This is absolutely amazing. Thanks for taking your time out to deliver this fantastic code. I am extremely grateful for your help.
It works as desired. I will make good use of it.
One thing I will try to see if I can re-purpose from the code is the ability to sort the data only based on the red font color. Would be useful to have that as its own separate function.

Again, Thank you so much.

 

[HighAndWilder]

I'm glad that you can make good use of it.

We are all hunkered down here with the hatches battoned down so need to find things to do.

What you are doing is not a standard approach so it needed a bit of clever code to tackle.

Explain how you want to just sort the data on the red font color.
I'm sure that I can sort something out if I understand it.

 

[naturally_data]

Yes, I hope you and your family are well and safe.
I want to sort by row so that the data in red font is on the left and the ones not in red are on the right.

I think this is where you identify the range to be sorted.

Range("E" & intRow).Value = intValue
Range("E" & intRow).Font.Color = vbRed

 

[HighAndWilder]

All safe and well thanks. I hope that you are too.

Re: I want to sort by row so that the data in red font is on the left and the ones not in red are on the right.

Is'nt that what the code does already?

The code ignores any other color font and just moves the red values to the left.

Do you want to sort the sort the numbers as well?

Maybe another image will explain it.