0

I have an Excel table, where I'd like that all rows (except the header row) in Sheet "CR" that have a value in it (excluding formulas if possible (column A contains formulas)) are sorted first by column B (name = TEAM), then C (name = BUILDING) and finally D (name = DATE_MAJ) before the file is saved.

I'm an absolute noob with VBA, so I'm trying out stuff that I find left and right on the fora and modify it to my needs. From searching around, I tried this code in the Excel VBA Object 'Workbook', but it gives an error:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
'Setup column names
Col1name = "SECTION"
Col2name = "BATIMENT"
Col3name = "DATE_MAJ"

'Find cols
For Each cell In Range("A1:" & Range("A1").End(xlToRight).Address)
    If cell.Value = Col1name Then
        Col1 = cell.Column
    End If
    If cell.Value = Col2name Then
        Col2 = cell.Column
    End If
    If cell.Value = Col3name Then
        Col3 = cell.Column
    End If

Next

'Below two line:- if they are blank e.g. column not found it will error so a small bit of error handling 
If Col1 = "" Then Exit Sub
If Col2 = "" Then Exit Sub
If Col3 = "" Then Exit Sub

'Find last row - dynamic part
lastrow = ActiveSheet.Range("A100000").End(xlUp).Row

'Convert col numer to name
Col1 = Split(Cells(1, Col1).Address(True, False), "$")
Col2 = Split(Cells(1, Col2).Address(True, False), "$")
Col3 = Split(Cells(1, Col3).Address(True, False), "$")

'Sort
With ActiveSheet.Sort
    .SortFields.Clear
    .SortFields.Add Key:=Range(Col1(0) & "2:" & Col1(0) & lastrow) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    .SortFields.Add Key:=Range(Col2(0) & "2:" & Col2(0) & lastrow) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    .SortFields.Add Key:=Range(Col3(0) & "2:" & Col3(0) & lastrow) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

    .SetRange Range("A1:K" & lastrow)
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With
End Sub

I'd be grateful for any help in getting the code right. Below is a link to the Excel file (I took out the above code as it didn't work).

Dropbox link to Excel file

4
  • What error do you experience? What line is throwing it? Furthermore your linked example doesn't have any columns header named after neither "BATIMENT" nor "DATE_MAJ" Commented Nov 12, 2016 at 14:19
  • The column names of columns C and D are "BATIMENT" and "DATE_MAJ" ; their headers are indeed "BUILDING" and "DATE UPDATE". Does that matter? Commented Nov 12, 2016 at 14:24
  • The error I'm getting is 'Compile error: variable not defined' and 'Col1name' is selected in the VBA code. Commented Nov 12, 2016 at 14:27
  • If your searching for a name (say "BATIMENT") in a range that doesn't have it (since there's a "BUILDING" somewhere), then you won't find it! As for the error: do you have an Option Explicit statement at the top of your Module? Commented Nov 12, 2016 at 14:35

1 Answer 1

2

Since you only have three sorting columns you may want to use Sort() method of Range object, instead of the namesake method of Worksheet object

Furthermore assuming columns headers as per linked excel files you could try this:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim col1 As Range, col2 As Range, col3 As Range
    Dim lastRow As Long

    'Setup column names
    Const col1Name As String = "SECTION"
    Const col2Name As String = "BUILDING" '"BATIMENT"
    Const col3Name As String = "DATE UPDATE" '"DATE_MAJ"

    With Worksheets("CR") '<--| reference your worksheet
        'Find last row - dynamic part
        lastRow = .Cells(.Rows.Count, 1).End(xlUp).row ' <--|find its column "A" last not empty row index
        'Find cols
        With .Range("A1", .Cells(1, .Columns.Count).End(xlToLeft)) '<--|reference its row 1 cells from column 1 to last not empty one and search for sorting columns whose header matches above set column names
            If Not TryGetColumnIndex(.Cells, col1Name, col1) Then Exit Sub '<--| if 1st sorting column not found then exit sub
            If Not TryGetColumnIndex(.Cells, col2Name, col2) Then Exit Sub '<--| if 2nd sorting column not found then exit sub
            If Not TryGetColumnIndex(.Cells, col3Name, col3) Then Exit Sub '<--| if 3rd sorting column not found then exit sub
            .Resize(lastRow).Sort _
                            key1:=col1, order1:=xlAscending, DataOption1:=xlSortNormal, _
                            key2:=col2, order2:=xlAscending, DataOption2:=xlSortNormal, _
                            key3:=col3, order3:=xlAscending, DataOption3:=xlSortNormal, _
                            Header:=xlYes, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod:=xlPinYin
        End With
    End With
End Sub

Function TryGetColumnIndex(rng As Range, colName As String, col As Range) As Boolean
    Set col = rng.Find(What:=colName, LookIn:=xlValues, LookAt:=xlWhole)
    TryGetColumnIndex = Not col Is Nothing
End Function
Sign up to request clarification or add additional context in comments.

5 Comments

Thanks, but that code gives the following: Run-time error '438': Object doesn't support this property or method. When clicking 'debug', the following line is highlighted: lastRow = .Cells(.Rows.Count, 1).End(xlUp).rowrow ' <--|find its column "A" last not empty row index
I pasted the code in the object 'ThisWorkbook'. I assume that's right?
@Antoon, did you get through it?
Thank you so much!!! There was still one small typo in the line following '.Resize(lastRow).Sort _' : changed col2 to col1 and now it works like a charm!
@Anton, if you want to Autofit rows after sorting, add .Resize(lastRow).Rows.AutoFit right after the .Resize(lastRow).Sort ... statement

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.