Sort colours

[Derek McGill]

Any code to sort this by highest Red colour and ties by lowest Green, So that it looks like bottom ?

 

[bobhc]

You may find this link of help

http://www.vbaexpress.com/kb/getarticle.php?kb_id=494


.

 

[jindon]

Don't understand the rest.

Sub test()
    Dim myCol As Long
    myCol = Rows(1).Find("Total Games").Column
    With Intersect(Columns(1).SpecialCells(2).Areas(1).EntireRow, Columns(1).Resize(, myCol).EntireColumn)
        .Offset(-1).Resize(.Rows.Count + 1).Copy .Offset(.Rows.Count + 4)
        With .Offset(.Rows.Count + 4).CurrentRegion.Resize(, myCol)
            .Columns(.Columns.Count).Replace ChrW(189), ".5", 2
            .Sort .Cells(1, .Columns.Count), 2, , , , , , 1
            .Columns(.Columns.Count).Replace ".5", ChrW(189), 2
            Union(.Columns(1), .Columns(.Columns.Count)).Copy .Columns(.Columns.Count + 3)
            With .Columns(.Columns.Count + 2)
                With .Offset(1).Resize(.Rows.Count - 1)
                    .Value = Evaluate("row(1:" & .Rows.Count & ")")
                    .CurrentRegion.Borders.Weight = 2
                    .CurrentRegion.BorderAround Weight:=4
                    .Columns(3).NumberFormat = "#.0"
                End With
            End With
        End With
    End With
End Sub

 

[Derek McGill]

You may find this link of help

http://www.vbaexpress.com/kb/getarticle.php?kb_id=494


.

It looks like it only sorts 1 col and has no VBA (that i can see )

 

[Derek McGill]

Its very nearly what I need, just need to sort any "Ties" based on no. of Red cells.

 

[jindon]

Change to

Sub test()
    Dim myCol As Long
    myCol = Rows(2).Find("#Red").Column
    With Intersect(Columns(1).SpecialCells(2).Areas(1).EntireRow, Columns(1).Resize(, myCol).EntireColumn)
        .Offset(-1).Resize(.Rows.Count + 1).Copy .Offset(.Rows.Count + 4)
        With .Offset(.Rows.Count + 4).CurrentRegion.Resize(, myCol)
            .Sort .Cells(1, .Columns.Count - 1), 2, , .Cells(1, .Columns.Count), 1, , , 1
            .Columns(.Columns.Count - 1).Resize(, 2).Clear
            Union(.Columns(1), .Columns(.Columns.Count - 2)).Copy .Columns(.Columns.Count + 1)
            With .Columns(.Columns.Count)
                With .Offset(1).Resize(.Rows.Count - 1)
                    .Value = Evaluate("row(1:" & .Rows.Count & ")")
                    .CurrentRegion.Borders.Weight = 2
                    .CurrentRegion.BorderAround Weight:=4
                    .Columns(3).NumberFormat = "#.0"
                End With
            End With
        End With
    End With
End Sub

 

[bobhc]

It looks like it only sorts 1 col and has no VBA (that i can see )

The site is called "VBA Express". all the code is there with full explanation of how to use, where to put the code, how to test....every thing!!!!

has no VBA

You need to see an optometrists.

 

[Derek McGill]

Error 1004 No cells were found.
Fixed this now.

 

[jindon]

Who are you talking to?

Do your country have an expression for appreciation by the way?

 

[Derek McGill]

To you ! Thanks for the code, Have got hang of the sort code, "Red" code giving trouble.

 

[Derek McGill]

Any tip on how to suppress " Do you want to replace contents of the destination cells" message ?

 

[jindon]

See the attached.

Sub test()
    Dim myCol As Long
    myCol = Rows(2).Find("#Red").Column
    Application.DisplayAlerts = False  '<-----
    With Intersect(Columns(1).SpecialCells(2).Areas(1).EntireRow, Columns(1).Resize(, myCol).EntireColumn)
        .Offset(-1).Resize(.Rows.Count + 1).Copy .Offset(.Rows.Count + 4)
        Application.DisplayAlerts = True  '<-----
        With .Offset(.Rows.Count + 4).CurrentRegion.Resize(, myCol)
            .Sort .Cells(1, .Columns.Count - 1), 2, , .Cells(1, .Columns.Count), 1, , , 1
            ........

 

[Derek McGill]

Thanks.

 

[Derek McGill]

Is there a fix for this code if Col A is formulas ?

 

[jindon]

.Rows.Count