HiveBrain v1.2.0
Get Started
← Back to all entries
patternMinor

Custom sorting an Excel Data Table (+ visual formatting)

Submitted by: @import:stackexchange-codereview··
0
Viewed 0 times
codereviewstackoverflowvba
sortingformattingexcelvisualcustomdatatable

Problem

I'm (re)building a data table to track our clients that receive regular income payments. Specifically, I need to pull this data into other workbooks for other reports, and since I was here anyway I decided to upgrade it and anticipate its' future growth.

A sample of the data table (minus sensitive data):

My code finds the Table Range, Determines the location of the sort-columns, Sorts the table using a 2-Level custom sort (then A-Z by name) and then does some visual formatting.

There is a sheet for every year and a button on each sheet, all linking to the same Macro, which operates on the Active Sheet.

These days, my main focus is on Maintainability (by me or someone else). In essence, if you got hired and were handed this as a thing to maintain, what would you be thinking as you read through it?

(There are a few standard methods not included. You may safely assume they do what they say they do)

Module "A1_Public_Variables"
Option Explicit

Public Const TOP_LEFT_CELL_STRING As String = "Client Name"

Public Const CLIENT_NAME_HEADER As String = "Client Name"
Public Const INCOME_AMOUNT_HEADER As String = "Income"
Public Const PAYMENT_FREQUENCY_HEADER As String = "Frequency"
Public Const PAYMENT_DAY_HEADER As String = "Date Paid"
Public Const BASE_MONTH_HEADER As String = "Base Month"
Public Const ASCENTRIC_WRAPPER_HEADER As String = "Wrapper"
Public Const ASCENTRIC_ACCOUNT_NUMBER_HEADER As String = "Ascentric Acc #"
Public Const ACCOUNT_TO_PAY_FROM_HEADER As String = "Account to pay from?"


Module "B1_Sort_Button_Click"
Option Explicit

```
Sub BtnSort_Click()

'/====================================================================================================
'/ Description:
'/ For the active sheet, finds the data Table and sortKey columns using headers.
'/ Sorts clients based on payment frequency, then payment day, then Client Name.
'/ Colours rows depending on their payment frequency.
'/===================================================

Solution

All right, I'll try to give some feedback where I can. My comments are mostly inside the code.

I wouldn't use variable names with underscores, but you need to do what you need to do with your constants. I would recommend changing this_ws to CurrentWS

I have no idea what storeapplicationsettings, disableapplicationsettings or restoreapplicationsettings do. What if there's an error? Will the settings all remain disabled? In fact, I don't see any error handling at all.

As for the comments like '/ Get sort columns why not say something like Call FindColumnIndexes to obtain sort columns.

Sub BtnSort_Click()

'/====================================================================================================
'/ Description:
'/  For the active sheet, finds the data Table and sortKey columns using headers.
'/  Sorts clients based on payment frequency, then payment day, then Client Name.
'/  Colours rows depending on their payment frequency.
'/====================================================================================================
    '?
    StoreApplicationSettings
    '?
    DisableApplicationSettings

        '/ set Worksheet
        Dim CurrentWS As Worksheet
        Set CurrentWS = ActiveSheet

        '/ Call Function GetTableRange to obtain the table's range
        Dim tableRange As Range
        Set tableRange = GetTableRange(CurrentWS)

        '/ Call Sub ValidateTableHeaders to check for existence of expected headers
        ValidateTableHeaders CurrentWS, tableRange

        '/ Call Sub FindColumnIndexes to check for headers and obtain column numbers
        Dim paymentFrequencyColNum As Long
        Dim paymentDayColNum As Long
        Dim clientNameColNum As Long

        FindColumnIndexes CurrentWS, tableRange, paymentFrequencyColNum, paymentDayColNum, clientNameColNum

        '/ Call Sub SortTableRange to apply sort defined within that sub
        SortTableRange CurrentWS, tableRange, paymentFrequencyColNum, paymentDayColNum, clientNameColNum

        '/ Call Sub FormatTableRange for Visual Formatting
        FormatTableRange CurrentWS, tableRange, paymentFrequencyColNum

    'If we don't get here, what happens?
    RestoreApplicationSettings

End Sub


Okay, that was pretty simple and explains to any future readers what you're doing and why you're doing it. If they want to see how it's done, they can check that process out.

Public Function GetTableRange(ByRef CurrentWS As Worksheet) As Range

'/ Finds the top left cell in the table by its' text. Determines the bounds of the table and returns it as a range object.

    '/ Find top left cell of table
    'Why were those cells picked? How is this working?
    Dim searchRange As Range
    Set searchRange = CurrentWS.Range(Cells(1, 1), Cells(10, 10))

    Dim topLeftCell As Range
    '? I assume this finds a range
    Set topLeftCell = CellContainingStringInRange(searchRange, TOP_LEFT_CELL_STRING)

    '/ Find table range
    'Why only give a full name to half of these?
    Dim FinalRow As Long, FinalCol As Long
    Dim StartRow As Long, StartCol As Long

        StartRow = topLeftCell.row
        StartCol = topLeftCell.Column

        FinalRow = Cells(Rows.Count, col).End(xlUp).row
        FinalCol = Cells(row, Columns.Count).End(xlToLeft).Column

        Set GetTableRange = Range(topLeftCell, Cells(FinalRow, FinalCol))

End Function


Not too much confusion on this one, except using functions that aren't supplied.

```
Public Sub ValidateTableHeaders(ByRef CurrentWS As Worksheet, ByRef tableRange As Range)
'/ Checks for the existence of all expected headers.

' no need to activate anything, we haven't moved as we passed CurrentWS in here via argument
'CurrentWS.Activate

'/ Get Expected Headers
Dim passedValidation As Boolean
Dim strErrorMessage As String

'Will this always be 1 to 21?
Dim expectedHeaders(1 To 21) As String '/ 9 headers + 12 months
'Again, I'm not sure what this is doing, but all right
ThisWorkbook.GetDataTableHeaders expectedHeaders(1), expectedHeaders(2), expectedHeaders(3), expectedHeaders(4), expectedHeaders(5) _
, expectedHeaders(6), expectedHeaders(7), expectedHeaders(8), expectedHeaders(9)

Dim i As Long
'Do you need to use this notation if you will always have 1 to 21 and look for 9? Why is the one above
'Explicitly defined and looks for what is expected, but then this one seems lost and needs to check?
For i = (UBound(expectedHeaders) - 11) To UBound(expectedHeaders)
expectedHeaders(i) = MonthName(i - UBound(expectedHeaders) + 12)
Next i

'/ Get Header Row
Dim arrHeaderRow As Variant
'why are you setting this?
arrHeaderRow = Array()

'Remind me what tableRange is - I know it's a range, but if it's the entire table, how are you using
'tablerange.column and tablerange.row?
Dim TblRow As Long, TblCol As Long
Dim Firs

Code Snippets

Sub BtnSort_Click()

'/====================================================================================================
'/ Description:
'/  For the active sheet, finds the data Table and sortKey columns using headers.
'/  Sorts clients based on payment frequency, then payment day, then Client Name.
'/  Colours rows depending on their payment frequency.
'/====================================================================================================
    '?
    StoreApplicationSettings
    '?
    DisableApplicationSettings

        '/ set Worksheet
        Dim CurrentWS As Worksheet
        Set CurrentWS = ActiveSheet

        '/ Call Function GetTableRange to obtain the table's range
        Dim tableRange As Range
        Set tableRange = GetTableRange(CurrentWS)

        '/ Call Sub ValidateTableHeaders to check for existence of expected headers
        ValidateTableHeaders CurrentWS, tableRange

        '/ Call Sub FindColumnIndexes to check for headers and obtain column numbers
        Dim paymentFrequencyColNum As Long
        Dim paymentDayColNum As Long
        Dim clientNameColNum As Long

        FindColumnIndexes CurrentWS, tableRange, paymentFrequencyColNum, paymentDayColNum, clientNameColNum

        '/ Call Sub SortTableRange to apply sort defined within that sub
        SortTableRange CurrentWS, tableRange, paymentFrequencyColNum, paymentDayColNum, clientNameColNum

        '/ Call Sub FormatTableRange for Visual Formatting
        FormatTableRange CurrentWS, tableRange, paymentFrequencyColNum

    'If we don't get here, what happens?
    RestoreApplicationSettings

End Sub
Public Function GetTableRange(ByRef CurrentWS As Worksheet) As Range

'/ Finds the top left cell in the table by its' text. Determines the bounds of the table and returns it as a range object.

    '/ Find top left cell of table
    'Why were those cells picked? How is this working?
    Dim searchRange As Range
    Set searchRange = CurrentWS.Range(Cells(1, 1), Cells(10, 10))

    Dim topLeftCell As Range
    '? I assume this finds a range
    Set topLeftCell = CellContainingStringInRange(searchRange, TOP_LEFT_CELL_STRING)

    '/ Find table range
    'Why only give a full name to half of these?
    Dim FinalRow As Long, FinalCol As Long
    Dim StartRow As Long, StartCol As Long

        StartRow = topLeftCell.row
        StartCol = topLeftCell.Column

        FinalRow = Cells(Rows.Count, col).End(xlUp).row
        FinalCol = Cells(row, Columns.Count).End(xlToLeft).Column

        Set GetTableRange = Range(topLeftCell, Cells(FinalRow, FinalCol))

End Function
Public Sub ValidateTableHeaders(ByRef CurrentWS As Worksheet, ByRef tableRange As Range)
    '/ Checks for the existence of all expected headers.

    ' no need to activate anything, we haven't moved as we passed CurrentWS in here via argument
    'CurrentWS.Activate


    '/ Get Expected Headers
    Dim passedValidation As Boolean
    Dim strErrorMessage As String

    'Will this always be 1 to 21?
    Dim expectedHeaders(1 To 21) As String '/ 9 headers + 12 months
        'Again, I'm not sure what this is doing, but all right
        ThisWorkbook.GetDataTableHeaders expectedHeaders(1), expectedHeaders(2), expectedHeaders(3), expectedHeaders(4), expectedHeaders(5) _
                                        , expectedHeaders(6), expectedHeaders(7), expectedHeaders(8), expectedHeaders(9)

    Dim i As Long
        'Do you need to use this notation if you will always have 1 to 21 and look for 9? Why is the one above
        'Explicitly defined and looks for what is expected, but then this one seems lost and needs to check?
        For i = (UBound(expectedHeaders) - 11) To UBound(expectedHeaders)
            expectedHeaders(i) = MonthName(i - UBound(expectedHeaders) + 12)
        Next i

    '/ Get Header Row
    Dim arrHeaderRow As Variant
    'why are you setting this?
        arrHeaderRow = Array()

    'Remind me what tableRange is - I know it's a range, but if it's the entire table, how are you using
    'tablerange.column and tablerange.row?
    Dim TblRow As Long, TblCol As Long
    Dim FirstCol As Long, FinalCol As Long
        TblRow = tableRange.row
        FirstCol = tableRange.Column
        FinalCol = FirstCol + (tableRange.Columns.Count - 1)

        ReDim arrHeaderRow(FirstCol To FinalCol)
        For TblCol = FirstCol To FinalCol
            arrHeaderRow(TblCol) = Cells(TblRow, TblCol).Text
        Next TblCol


    '/ Search header row for all expected Headers
    'There has to be a better name for these, I can take a guess but I don't know what that function is doing
    'If you find yourself using numbers in variable names, you either have too many variables or your variables
    'aren't descriptive enough in their name
    Dim LB1 As Long, UB1 As Long
        '?
        AssignArrayBounds expectedHeaders, LB1, UB1

    'Why ix? For Index?
    Dim ix As Variant
    Dim searchString As String

    passedValidation = True

    For i = LB1 To UB1
        searchString = expectedHeaders(i)
        '? What's this function do?
        ix = IndexInArray1d(arrHeaderRow, searchString)
        If IsError(ix) Then
            passedValidation = False
            strErrorMessage = strErrorMessage & "Could not find header """ & searchString & """ (non-case sensitive)"
        End If
    Next i


    '/ If applicable, show error message and stop execution
    If Not passedValidation Then PrintErrorMessage strErrorMessage, endExecution:=True

End Sub
Public Sub FindColumnIndexes(ByRef CurrentWS As Worksheet, ByRef tableRange As Range, ByRef paymentFrequencyColNum As Long, ByRef paymentDayColNum As Long, ByRef clientNameColNum As Long)
'/ Pulls out the header row as an array. Search for specific headers and returns their column numbers.

    ' no need to activate anything, we haven't moved as we passed CurrentWS in here via argument
    'CurrentWS.Activate

    '/ Get Header Row as range
    Dim rngHeaderRow As Range
    Dim lngHeaderRow As Long

    Dim FirstCol As Long, FinalCol As Long
        'I'm still confused if tablerange is a large range, what column is it picking?
        FirstCol = tableRange.Column
        FinalCol = FirstCol + (tableRange.Columns.Count - 1)
        'same here
        lngHeaderRow = tableRange.row

        Set rngHeaderRow = Range(Cells(lngHeaderRow, FirstCol), Cells(lngHeaderRow, FinalCol))

    '/ Read Header Row to Array
    ' why not Dim arrheaderow() As Variant
    Dim arrheaderrow As Variant
        'What's going on here?
        arrheaderrow = Array()
    'Not a fan of these variables, not descriptie at all
    Dim col As Long, i As Long

        ReDim arrheaderrow(1 To tableRange.Columns.Count)

        For col = FirstCol To FinalCol
            i = (col - FirstCol) + 1
            arrheaderrow(i) = Cells(lngHeaderRow, col).Text
        Next col

    '/ Find column numbers
    'I have no idea what happens here
        paymentFrequencyColNum = IndexInArray1d(arrheaderrow, PAYMENT_FREQUENCY_HEADER) + (FirstCol - 1)
        paymentDayColNum = IndexInArray1d(arrheaderrow, PAYMENT_DAY_HEADER) + (FirstCol - 1)
        clientNameColNum = IndexInArray1d(arrheaderrow, CLIENT_NAME_HEADER) + (FirstCol - 1)

End Sub
Public Sub SortTableRange(ByRef CurrentWS As Worksheet, ByRef tableRange As Range, ByVal paymentFrequencyColNum As Long, ByVal paymentDayColNum As Long, ByVal clientNameColNum As Long)
'/ Sorts range based on payment frequency, then payment day, then Client Name, using custom sort lists for the first 2.

    ' no need to activate anything, we haven't moved as we passed CurrentWS in here via argument
    'CurrentWS.Activate

    '/ Get Custom sort list for payment frequency
    Dim paymentFrequencySortList As Variant
        'Why are you calling this to populate your array? It looks like it could be a constant
        paymentFrequencySortList = GetpaymentFrequencySortList()

    Dim strPaymentFrequencySortList As String
        strPaymentFrequencySortList = Join(paymentFrequencySortList, ",")

    '/ Get Custom sort list for payment day
    'Same question here
    Dim paymentDaySortList As Variant
        paymentDaySortList = GetPaymentDaySortList()

    Dim strPaymentDaySortList As String
        strPaymentDaySortList = Join(paymentDaySortList, ",")

    '/ Get first/last rows
    'One is capital the other isn't, I'd stick with capitals
    Dim firstRow As Long, FinalRow As Long
        firstRow = tableRange.row
        FinalRow = firstRow + (tableRange.Rows.Count - 1)

    '/ get column ranges
    'This would be a great place to explain how you're getting this information
    'and why you're doing it that way
    Dim rngPaymentFrequencyCol As Range, rngPaymentDayCol As Range, rngClientNameCol As Range

        Set rngPaymentFrequencyCol = Range(Cells(firstRow, paymentFrequencyColNum), Cells(FinalRow, paymentFrequencyColNum))
        Set rngPaymentDayCol = Range(Cells(firstRow, paymentDayColNum), Cells(FinalRow, paymentDayColNum))
        Set rngClientNameCol = Range(Cells(firstRow, clientNameColNum), Cells(FinalRow, clientNameColNum))

    '/ Sort Range
    'Is this a standard sort that should never change? If so, indicate that
    With CurrentWS.Sort
        .SortFields.Clear
        .SortFields.Add Key:=rngPaymentFrequencyCol, SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:=CVar(strPaymentFrequencySortList) '/ CVar is necessary to get VBA to accept the string. No idea why.
        .SortFields.Add Key:=rngPaymentDayCol, SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:=CVar(strPaymentDaySortList)
        .SortFields.Add Key:=rngClientNameCol, SortOn:=xlSortOnValues, Order:=xlAscending

        .SetRange tableRange
        .Header = xlYes
        .MatchCase = False
        .SortMethod = xlPinYin
        .Apply
    End With

End Sub

Context

StackExchange Code Review Q#113264, answer score: 3

Revisions (0)

No revisions yet.