Custom Sorting via VBA

[REUBEN]

Hi All,

I need to sort three columns on a condition that the First column 'B', is sorted in alphabetical ascending order, then column 'C' is sorted based on the texts is contains and finally column 'D' is sorted with the texts it contains.

Background on the sheet (only FYI), column 'B' is the name of customers, column 'C' is the service we provided them and column 'D' is the specific task we did for them within the respective service. And the options in column 'B' and 'D' are provided via a drop down menu. So the text phrases/options remains the same.

I am unable to script anything in VBA and I understand the above would need to be coded in to VBA.

Thank you for helping me out.

 

[REUBEN]

I'm not a real expert on Tables (ListObjects) but I don't think you can exclude a row from the sort. Happy to be shown to be wrong though.

My work-around is to remove the last row of the table that has any data (your text row), sort the table and then reinsert the text.
Perhaps somebody else will have a more direct method.

Sub Sort_Table()
  Dim lr As Long
  Dim a As Variant
  
  Application.ScreenUpdating = False
  With ActiveSheet.ListObjects("Table1").Range
    lr = .Find(What:="*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, SearchFormat:=False).Row - .Row + 1
    a = .Rows(lr).Value
    .Rows(lr).ClearContents
    .Sort Key1:=.Columns(1), Order1:=xlAscending, Key2:=.Columns(2), Order2:=xlAscending, _
          Key3:=.Columns(3), Order3:=xlAscending, Header:=xlYes, Orientation:=xlTopToBottom
    .Rows(lr).Value = a
  End With
  Application.ScreenUpdating = True
End Sub

If your table name is not "Table1" then adjust that in the code.
If you only have one table on the sheet then an alternative would be to change that line to

With ActiveSheet.ListObjects(1).Range

Peter,

That was fantastic! Did just what I needed! Thank you so much.

My table is Table15 in the sheet and there are two different sheets so I put the code in the workbook and then ran it from the macros ribbon. Will link a button to it and place the button in the sheet.

Thanks once again!

 

[Peter_SSs]

Peter,

That was fantastic! Did just what I needed! Thank you so much.

You are most welcome. Glad it helped.

 

[REUBEN]

You are most welcome. Glad it helped.

Hi Peter,

After using your super helpful code for a while. There are some issues I could see in the sorting of the data. A small one was that the data in columns F through to H were messing up in their alignment. Which I read up a little about and could fix it. But things go very wrong if I have added some empty rows after the last row with my instructional text. For if we one is to run the sorting code then it pull the empty rows right to the top and also my instructional info row to where it belongs alphabetically.

Any suggestions on a code that would check for empty rows from the bottom of the table and then find the previous row where the cell in Col. B would consists of the text "Enter Brief Details on Next Case or Task"? As then that row and the other empty rows would need to cleared out, then the sorting made and finally paste back all the data.

Your thoughts?

 

[Peter_SSs]

That is all pretty meaningless to me I'm afraid. "columns F through to H were messing up in their alignment" is not very descriptive.

I tested with empty rows below the text rows and it worked fine for me. Are you sure that they are actually completely empty?

Any chance that you could post some small sample dummy data so that we could test with something that is actually like you have?

 

[REUBEN]

That is all pretty meaningless to me I'm afraid. "columns F through to H were messing up in their alignment" is not very descriptive.

I meant that after running the sort macro, the data in these columns was changing its alignment from center to right in some cases (randomly). Anyway that was fixed with this code I inserted in your code -

Columns("F:H").HorizontalAlignment = xlCenter

As regards, the sheet and the so called empty columns I thought were empty, we like you said not empty as I had some code to make it look like there's no data in them based on certain conditions.

I am enclosing a link to the sheet as it takes too long to recreate the table here. - https://drive.google.com/file/d/0B8NyjX9raccOcllDUXIyLVM1NEE/view?usp=sharing

 

[Peter_SSs]

Try this version. It should "clean up" those other 'blank' rows of the table. Is that what you wanted as well?

Sub Sort_Table_v2()
  Dim lo As ListObject
  Dim lr As Long, Rws As Long, r As Long
  Dim a As Variant
  
  Application.ScreenUpdating = False
  Set lo = ActiveSheet.ListObjects("Table1")
  With lo.Range
    lr = .Find(What:="*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, SearchFormat:=False).Row - .Row + 1
    Rws = .Rows.Count - lr + 1
    a = .Rows(lr).Formula
    For r = 1 To Rws
      lo.ListRows(lo.Range.Rows.Count - 1).Delete
    Next r
    .Sort Key1:=.Columns(1), Order1:=xlAscending, Key2:=.Columns(2), Order2:=xlAscending, _
          Key3:=.Columns(3), Order3:=xlAscending, Header:=xlYes, Orientation:=xlTopToBottom
    .Rows(lr).Formula = a
  End With
  Columns("F:H").HorizontalAlignment = xlCenter
  Application.ScreenUpdating = True
End Sub

 

[REUBEN]

Thanks again.

The code does remove the empty rows, but after sorting the data, it doesnt put the empty rows back in again. Also, the row with the text was put back but with different font sizing in some cells of that row.

I think I will stick with the previous solution. And just not have any empty rows after my text row.

 

[Peter_SSs]

.. it doesnt put the empty rows back in again.

Yes, that's what I meant by the following. I thought perhaps you wanted that but on re-reading the thread I see that is not the case.

It should "clean up" those other 'blank' rows of the table.

Give this version a try. It should keep any blank rows at the end and doesn't involve removing and replacing that text row so I think it should keep all its own formatting.

Sub Sort_Table_v3()
  Dim lo As ListObject
  Dim lr As Long
  
  Application.ScreenUpdating = False
  Set lo = ActiveSheet.ListObjects("Table1")
  lo.ListColumns.Add Position:=2
  With lo.Range
    lr = .Find(What:="*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, SearchFormat:=False).Row - .Row
    .Cells(2, 2).FormulaR1C1 = "=IF(ROWS(R3C:RC)<" & lr & ",[@[" & .Cells(1, 1).Value & "]],""zzz""&TEXT(ROW(),""0000""))"
    .Columns(2).Value = .Columns(2).Value
    .Sort Key1:=.Columns(2), Order1:=xlAscending, Key2:=.Columns(3), Order2:=xlAscending, _
          Key3:=.Columns(4), Order3:=xlAscending, Header:=xlYes, Orientation:=xlTopToBottom
  End With
  lo.ListColumns(2).Delete
  Columns("F:H").HorizontalAlignment = xlCenter
  Application.ScreenUpdating = True
End Sub

 

[REUBEN]

Hi Peter,

Many thanks for trying again. Although the code seems to sort the data fine it unfortunately still moves the last row and the empty rows right up to the top after the sorting has finished.

Your first code is still my favourite.

Sub Sort_Table()  Dim lr As Long
  Dim a As Variant
  
  Application.ScreenUpdating = False
  With ActiveSheet.ListObjects("Table1").Range
    lr = .Find(What:="*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, SearchFormat:=False).Row - .Row + 1
    a = .Rows(lr).Value
    .Rows(lr).ClearContents
    .Sort Key1:=.Columns(1), Order1:=xlAscending, Key2:=.Columns(2), Order2:=xlAscending, _
          Key3:=.Columns(3), Order3:=xlAscending, Header:=xlYes, Orientation:=xlTopToBottom
    .Rows(lr).Value = a
  End With
  Columns("F:H").HorizontalAlignment = xlCenter
  Application.ScreenUpdating = True
End Sub

 

[Peter_SSs]

Although the code seems to sort the data fine it unfortunately still moves the last row and the empty rows right up to the top after the sorting has finished.

1. Is that in the sample file too, or just your actual file?
I tested the code on the sample file (after tabbing so that a couple of new blank rows were created at the bottom) and it sorted fine, leaving the text row and the two blank rows at the bottom.

2. What happens if you change this line in my last code?

lr = .Find(What:="??*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, SearchFormat:=False).Row - .Row