Sort - Three Variations

[Papi]

Is it possible to sort using the three criteria in the noted sequence?

1) UPPER CASE
2) Bold (Proper)
3) Italics (Proper)

 

[TKB]

are some cells 2 or more of the criteria you listed? And if so, what is the order you would want it it? For example, say 2 cells are Upper Case, but one is bold, and one is italic, would you want bold first, then italics (in the upper case section)?

I can probably put together a simple macro for you with that information.

 

[Papi]

Hello TBK,

Thanks. There could be as many as thirty of each one (Maybe more later on). Another thing is each column (there are ten right now) have to be sorted like the former "Lists" found in 2003 (This is being done in 2010 and I have to figure out how they do that in the new version - To make the columns independent of each other) This would be an example (Bold and Italics are simply noted to identify where they would sort):

HIGH PROTEIN
HIGH PROTEIN
LOW CHOLESTEROL
LOW CHOLESTEROL
LOW CHOLESTEROL
Black Beans (Bold)
Lentils (Bold)
Lima Beans (Bold)
Fruit Juice (Italics)
Liquor (Italics)
Wine(Italics)

 

[TKB]

is there any chance you could put a column in between each list?

 

[TKB]

Try using this:

Select the first cell in the column you want to sort the run the following macro (Make sure you try this on a copy of the original woorkbook as a just in case. It worked fine for me many times, but you never know):

Sub Sorting()


Dim Cell2 As String


Cell2 = ActiveCell.Address


Column2 = ActiveCell.Offset(0, 1).EntireColumn.AddressLocal


Range(Column2).Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove


Range(Cell2).Select


Do Until ActiveCell.Text = ""


Dim Cell


Cell = ActiveCell


If Cell = UCase(Cell) Then


ActiveCell.Offset(0, 1).Value = 1


Else


If Selection.Font.Bold = True Then


ActiveCell.Offset(0, 1).Value = 2


Else


If Selection.Font.Italic = True Then


ActiveCell.Offset(0, 1).Value = 3


End If
End If
End If


ActiveCell.Offset(1, 0).Select


Loop


ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=ActiveCell.Columns.Offset(0, 1), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range(ActiveCell, ActiveCell.Offset(0, 1)).EntireColumn
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
Range(Column2).Select
    Selection.Delete Shift:=xlToLeft


Range(Cell2).Select




End Sub

Hope that works for you

 

[Papi]

Hello TBK,

Thanks again. Wow, it works quite fast. I ended up with one column that goes down to row 41 and it misses a few near the bottom. I am still running it to see if I did something wrong. What is the column to the right doing (I think you call it column 2)? It works, I just do not understand it.

 

[Papi]

Sorry about the spelling on your log in name TKB

 

[Papi]

I ran through quite a few times and sometimes it works and other times not. To test it I sorted alphabetical with no regard to CAPS, Bold and Italics to get them out of sequence. When I ran the code the following shows how it sorted but Green Beans sorted below Yellow Beans. I'm not sure if I am doing something wrong.

Category
HIGH PROTEIN
HIGH PROTEIN
LOW CHOLESTEROL
LOW CHOLESTEROL
LOW CHOLESTEROL
Black Beans (Bold)
Lentils (Bold)
Lima Beans (Bold)
Yellow Beans (Bold)
Green Beans (Bold)
Fruit Juice (Italics)
Liquor (Italics)
Wine (Italics)

 

[TKB]

What the macro does is it sets each font format to a #.
Upper Case = 1
Bold = 2
Italic = 3

It lists those numbers in a column that it adds to the right of the list of items. Then it grabs both columns and sorts it by the column with the numbers. Here is the order of events:

1. Add a new blank column next to the list of items (to the right)

2. For each font format, add the appropriate number in the newly added cell to the right.

3. Sort both columns based on the numbers in the newly formed and filled out column.

4. Remove the second column (remove the column we added in the beginning)

Did you want them to also stay alphabetically?

We can do that too

 

[TKB]

Try this:

Sub Sorting()




Dim Cell2 As String




Cell2 = ActiveCell.Address




Column2 = ActiveCell.Offset(0, 1).EntireColumn.AddressLocal




Range(Column2).Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove





Range(Cell2).Select




Do Until ActiveCell.Text = ""




Dim Cell




Cell = ActiveCell




If Cell = UCase(Cell) Then




ActiveCell.Offset(0, 1).Value = 1




Else




If Selection.Font.Bold = True Then




ActiveCell.Offset(0, 1).Value = 2




Else




If Selection.Font.Italic = True Then




ActiveCell.Offset(0, 1).Value = 3




End If
End If
End If




ActiveCell.Offset(1, 0).Select




Loop




ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=ActiveCell.Columns.Offset(0, 1), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=ActiveCell.Columns _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal



    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range(ActiveCell, ActiveCell.Offset(0, 1)).EntireColumn
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
Range(Column2).Select
    Selection.Delete Shift:=xlToLeft




Range(Cell2).Select








End Sub