Sort by Column Header Text which May Change Position

[ljknight]

Hi Board!

I am trying to help some users to sort data correctly by attaching the sort function to a button. If they do not add any columns to the sheet, they can auto-sort (via the button) which has this code attached:

Selection.Sort Key1:=Range("AC9"), Order1:=xlDescending, Header:=xlYes, _OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

The "Header" in the above refers to text in cell "AC8" which says "Total."

My problem is that the users may insert or delete columns prior to sorting, and so the Header cell ("Total") may not be "AC8" but instead be "AF8" or "H8". In any case, it will be the last active column of the worksheet, and SHOULD always be in row 8, with data beginning in row 9, but could have any number of rows below that.

How can I automate this sort when I don't have any real "constants"?

While I am here, if I could also delete any rows where "Total" = 0 (again, keeping in mind that the Total column could be anywhere, but should be in row 8, and the number of data rows SHOULD start at 9 but is totally variable as to number of rows below that), it would be WONDERFUL!!

ANY of this do-able??

 

[BrianB]

I think this is what you want. Alt+F11 keys to get a code module & copy/paste this macro :-

Sub test()
    Dim FoundCell As Object
    Dim FoundCol As Long
    Dim LastRow As Long
    '-----------------------------------------
    Application.Calculation = xlCalculationManual
    Set FoundCell = ActiveSheet.Rows(8).Find(what:="Total")
    '- check Total column found
    If FoundCell Is Nothing Then
        MsgBox ("Cannot find Total column")
        End
    End If
    '- sort
    FoundCol = FoundCell.Column
    ActiveSheet.Range("A9").Sort Key1:=Cells(8, FoundCol), Order1:=xlDescending, Header:=xlYes, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    '- remove zero total rows from bottom
    LastRow = ActiveSheet.Cells(65536, FoundCol).End(xlUp).Row
    While ActiveSheet.Cells(LastRow, FoundCol).Value = 0
        ActiveSheet.Cells(LastRow, 1).EntireRow.Delete
        LastRow = LastRow - 1
    Wend
    MsgBox ("Done")
    Application.Calculation = xlCalculationAutomatic
End Sub

 

[ljknight]

Thanks Brian! I kept getting the "VBA X 400" error when running your code, so I modified it a bit as per below:

Sub Sort_Rank()
Dim FoundCell As Object
Dim FoundCol As Long
Dim LastRow As Long

Application.Calculation = xlCalculationManual
Set FoundCell = ActiveSheet.Cells.Find(What:="TOTAL", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
False).Activate
FoundCol = FoundCell.Column
ActiveSheet.Range("B10").Sort Key1:=Cells(10, FoundCol), Order1:=xlDescending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
LastRow = ActiveSheet.Cells(65536, FoundCol).End(xlUp).Row
While ActiveSheet.Cells(LastRow, FoundCol).Value = 0
ActiveSheet.Cells(LastRow, 1).EntireRow.Delete
LastRow = LastRow - 1
Wend
MsgBox ("Done")
Application.Calculation = xlCalculationAutomatic
End Sub

Now I am getting an "Object Required" error message.

Help???