7
\$\begingroup\$

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): enter image description here

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.
'/====================================================================================================

    StoreApplicationSettings

    DisableApplicationSettings

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

        '/ Get table Range
        Dim tableRange As Range
        Set tableRange = GetTableRange(ws_this)

        '/ Validate Column Headers
        ValidateTableHeaders ws_this, tableRange

        '/ Get sort columns
        Dim paymentFrequencyColNum As Long
        Dim paymentDayColNum As Long
        Dim clientNameColNum As Long

        FindColumnIndexes ws_this, tableRange, paymentFrequencyColNum, paymentDayColNum, clientNameColNum

        '/ Sort Table
        SortTableRange ws_this, tableRange, paymentFrequencyColNum, paymentDayColNum, clientNameColNum

        '/ Visual Formatting
        FormatTableRange ws_this, tableRange, paymentFrequencyColNum

    RestoreApplicationSettings

End Sub

Module "B2_Get_Table" Option Explicit

Public Function GetTableRange(ByRef ws_this 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
    Dim searchRange As Range
    Set searchRange = ws_this.Range(Cells(1, 1), Cells(10, 10))

    Dim topLeftCell As Range
    Set topLeftCell = CellContainingStringInRange(searchRange, TOP_LEFT_CELL_STRING)

    '/ Find table range
    Dim finalRow As Long, finalCol As Long
    Dim row As Long, col As Long

        row = topLeftCell.row
        col = 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

Module "B3_Validate_Table_headers"

Option Explicit

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

    ws_this.Activate


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

    Dim expectedHeaders(1 To 21) As String '/ 9 headers + 12 months

        ThisWorkbook.GetDataTableHeaders expectedHeaders(1), expectedHeaders(2), expectedHeaders(3), expectedHeaders(4), expectedHeaders(5) _
                                        , expectedHeaders(6), expectedHeaders(7), expectedHeaders(8), expectedHeaders(9)

    Dim i As Long
        For i = (UBound(expectedHeaders) - 11) To UBound(expectedHeaders)
            expectedHeaders(i) = MonthName(i - UBound(expectedHeaders) + 12)
        Next i

    '/ Get Header Row
    Dim arrHeaderRow As Variant
        arrHeaderRow = Array()

    Dim row As Long, col As Long
    Dim firstCol As Long, finalCol As Long
        row = tableRange.row
        firstCol = tableRange.Column
        finalCol = firstCol + (tableRange.Columns.Count - 1)

        ReDim arrHeaderRow(firstCol To finalCol)
        For col = firstCol To finalCol
            arrHeaderRow(col) = Cells(row, col).Text
        Next col


    '/ Search header row for all expected Headers
    Dim LB1 As Long, UB1 As Long
        AssignArrayBounds expectedHeaders, LB1, UB1

    Dim ix As Variant
    Dim searchString As String

    passedValidation = True

    For i = LB1 To UB1
        searchString = expectedHeaders(i)
        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

Module "B4_Get_Column_Indexes"

Option Explicit

Public Sub FindColumnIndexes(ByRef ws_this 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.

    ws_this.Activate

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

    Dim firstCol As Long, finalCol As Long
        firstCol = tableRange.Column
        finalCol = firstCol + (tableRange.Columns.Count - 1)

        lngHeaderRow = tableRange.row

        Set rngHeaderRow = Range(Cells(lngHeaderRow, firstCol), Cells(lngHeaderRow, finalCol))

    '/ Read Header Row to Array
    Dim arrHeaderRow As Variant
        arrHeaderRow = Array()

    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
        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

Module "B5_Sort_Table"

Option Explicit

Public Sub SortTableRange(ByRef ws_this 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.

    ws_this.Activate

    '/ Get Custom sort list for payment frequency
    Dim paymentFrequencySortList As Variant
        paymentFrequencySortList = GetpaymentFrequencySortList()

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

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

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

    '/ Get first/last rows
    Dim firstRow As Long, finalRow As Long
        firstRow = tableRange.row
        finalRow = firstRow + (tableRange.Rows.Count - 1)

    '/ get column ranges
    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
    With ws_this.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

Public Function GetpaymentFrequencySortList() As Variant

    Dim arr As Variant
        arr = Array()

        ReDim arr(1 To 3)

        arr(1) = "Monthly" '/ "Low" item
        arr(2) = "Quarterly"
        arr(3) = "Annually" '/ "High" item

    GetpaymentFrequencySortList = arr

End Function

Public Function GetPaymentDaySortList() As Variant

    Dim arr As Variant
        arr = Array()

        ReDim arr(1 To 31)

        arr(1) = "1st" '/ "Low" Item
        arr(2) = "2nd"
        arr(3) = "3rd"
        arr(4) = "4th"
        arr(5) = "5th"
        arr(6) = "6th"
        arr(7) = "7th"
        arr(8) = "8th"
        arr(9) = "9th"
        arr(10) = "10th"
        arr(11) = "11th"
        arr(12) = "12th"
        arr(13) = "13th"
        arr(14) = "14th"
        arr(15) = "15th"
        arr(16) = "16th"
        arr(17) = "17th"
        arr(18) = "18th"
        arr(19) = "19th"
        arr(20) = "20th"
        arr(21) = "21st"
        arr(22) = "22nd"
        arr(23) = "23rd"
        arr(24) = "24th"
        arr(25) = "25th"
        arr(26) = "26th"
        arr(27) = "27th"
        arr(28) = "28th"
        arr(29) = "29th"
        arr(30) = "30th"
        arr(31) = "31st" '/ "High" Item

    GetPaymentDaySortList = arr

End Function

Module "B6_Format_Table" Option Explicit

Public Sub FormatTableRange(ByRef ws_this As Worksheet, ByRef tableRange As Range, ByVal paymentFrequencyColNum As Long)
'/ Colour rows based on Payment frequency, add cell borders, autofit columns and then set the "Cash Made Available?" columns to fixed-width.

    ws_this.Activate

    '/ Set fixed width for "Cash Made Available?" columns
    Dim colWidthCashAvailable As Long
        colWidthCashAvailable = 10

    '/ Set Range bounds of table
    Dim firstRow As Long, firstCol As Long
    Dim finalRow As Long, finalCol As Long

    Dim topLeftCell As Range
    Set topLeftCell = Cells(tableRange.row, tableRange.Column)

        AssignRangeBoundsOfData topLeftCell, firstRow, finalRow, firstCol, finalCol, False

    Dim firstCashAvailableCol As Long
        firstCashAvailableCol = finalCol - (12 - 1) '/ 12 months

    '/ Colour rows based on payment frequency
    ws_this.Cells.Interior.Color = xlNone

    Dim row As Long, col As Long
    Dim paymentFrequency As String
    Dim strColour As String, dblColourShade As Double
    Dim rngRow As Range

        For row = firstRow + 1 To finalRow '/ +1 for headers
        '/ Set strColour inside conditions in case we want to use different colours for each in the future

            paymentFrequency = Cells(row, paymentFrequencyColNum).Text
            Set rngRow = Range(Cells(row, firstCol), Cells(row, finalCol))

            Select Case paymentFrequency

                Case Is = "Monthly"
                    strColour = "Lumin Tourquoise"
                    dblColourShade = DblBaseShade - (DblShadeIncrement * -6)
                    ColourFill rngRow, strColour, dblColourShade

                Case Is = "Quarterly"
                    strColour = "Lumin Tourquoise"
                    dblColourShade = DblBaseShade - (DblShadeIncrement * -4)
                    ColourFill rngRow, strColour, dblColourShade

                Case Is = "Annually"
                    strColour = "Lumin Tourquoise"
                    dblColourShade = DblBaseShade - (DblShadeIncrement * -2)
                    ColourFill rngRow, strColour, dblColourShade

                Case Else
                    ErrorMessage "Couldn't identify frequency """ & paymentFrequency & """ on row " & row & ". Please check that it is entered correctly."

            End Select

        Next row

    '/ Set Borders
    Dim rngCell As Range

    ws_this.Cells.Borders.LineStyle = xlNone

        For row = firstRow + 1 To finalRow '/ +1 for headers

            Set rngRow = Range(Cells(row, firstCol), Cells(row, finalCol))

            For Each rngCell In rngRow
                rngCell.BorderAround xlContinuous, xlThin, xlColorIndexAutomatic
            Next rngCell

        Next row

    '/ Set Header Borders
    Dim rngHeaderRow As Range
    Set rngHeaderRow = Range(Cells(firstRow, firstCol), Cells(firstRow, finalCol))

            For Each rngCell In rngHeaderRow
                rngCell.BorderAround xlContinuous, xlMedium, xlColorIndexAutomatic
            Next rngCell

    Set rngCell = Range(Cells(firstRow - 1, firstCashAvailableCol), Cells(firstRow - 1, finalCol)) '/ The extra "Cash made available" Header Cell
        rngCell.BorderAround xlContinuous, xlMedium, xlColorIndexAutomatic

    '/ Set column widths
    ws_this.Columns.AutoFit

    For col = firstCashAvailableCol To finalCol
        Columns(col).ColumnWidth = colWidthCashAvailable
    Next col

End Sub
\$\endgroup\$
  • 1
    \$\begingroup\$ Is there a reason you need any of those .Activates? \$\endgroup\$ – Raystafarian Dec 8 '15 at 17:21
  • 1
    \$\begingroup\$ Also, most of the comments tell the reader what's happening, rather than why it's happening or what it's accomplishing and how it's being accomplished. Also, I too am puzzled by the need for Cvar \$\endgroup\$ – Raystafarian Dec 8 '15 at 17:28
  • \$\begingroup\$ @Raystafarian Need? No. But I prefer not to make assumptions I don't have to. \$\endgroup\$ – Kaz Dec 9 '15 at 9:36
  • \$\begingroup\$ If my function isn't activating the sheet, then it is *implicitly* assuming that the sheet is *already* activated. Why make assumptions you don't have to. \$\endgroup\$ – Kaz Dec 10 '15 at 19:24
  • \$\begingroup\$ The thing is, say you're working with searchrange or tablerange, they are already defined as that sheet. \$\endgroup\$ – Raystafarian Dec 10 '15 at 19:25
3
\$\begingroup\$

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 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

Same as before, some names changed, other need better names. More functions that are mysterious. I did have questions about your arrays.

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

Nothing new here.

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

This one has a great opportunity for comments explaining why you call functions and how you determined methods.

Public Sub FormatTableRange(ByRef CurrentWS As Worksheet, ByRef tableRange As Range, ByVal paymentFrequencyColNum As Long)
'/ Colour rows based on Payment frequency, add cell borders, autofit columns and then set the "Cash Made Available?" columns to fixed-width.

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

    '/ Set fixed width for "Cash Made Available?" columns
    Dim colWidthCashAvailable As Long
        colWidthCashAvailable = 10

    '/ Set Range bounds of table
    'poor firstrow, the only lowercase
    Dim firstRow As Long, FirstCol As Long
    Dim FinalRow As Long, FinalCol As Long

    Dim topLeftCell As Range
    Set topLeftCell = Cells(tableRange.row, tableRange.Column)
        '?
        AssignRangeBoundsOfData topLeftCell, firstRow, FinalRow, FirstCol, FinalCol, False

    Dim firstCashAvailableCol As Long
        firstCashAvailableCol = FinalCol - (12 - 1) '/ 12 months

    '/ Colour rows based on payment frequency
    CurrentWS.Cells.Interior.Color = xlNone

    'These are good variable names, but we run into row and col again
    Dim row As Long, col As Long
    Dim paymentFrequency As String
    Dim strColour As String, dblColourShade As Double
    Dim rngRow As Range

        For row = firstRow + 1 To FinalRow '/ +1 for headers
        '/ Set strColour inside conditions in case we want to use different colours for each in the future

            paymentFrequency = Cells(row, paymentFrequencyColNum).Text

            Set rngRow = Range(Cells(row, FirstCol), Cells(row, FinalCol))

            'You might be better off making strColour a constant - it does the same thing each case?
            Select Case paymentFrequency

                Case Is = "Monthly"
                    strColour = "Lumin Tourquoise"
                    dblColourShade = DblBaseShade - (DblShadeIncrement * -6)
                    ColourFill rngRow, strColour, dblColourShade

                Case Is = "Quarterly"
                    strColour = "Lumin Tourquoise"
                    dblColourShade = DblBaseShade - (DblShadeIncrement * -4)
                    ColourFill rngRow, strColour, dblColourShade

                Case Is = "Annually"
                    strColour = "Lumin Tourquoise"
                    dblColourShade = DblBaseShade - (DblShadeIncrement * -2)
                    ColourFill rngRow, strColour, dblColourShade

                Case Else
                    ErrorMessage "Couldn't identify frequency """ & paymentFrequency & """ on row " & row & ". Please check that it is entered correctly."

            End Select

        Next row

    '/ Set Borders
    Dim rngCell As Range

    CurrentWS.Cells.Borders.LineStyle = xlNone

        For row = firstRow + 1 To FinalRow '/ +1 for headers

            Set rngRow = Range(Cells(row, FirstCol), Cells(row, FinalCol))

            For Each rngCell In rngRow
                rngCell.BorderAround xlContinuous, xlThin, xlColorIndexAutomatic
            Next rngCell

        Next row

    '/ Set Header Borders
    Dim rngHeaderRow As Range
    Set rngHeaderRow = Range(Cells(firstRow, FirstCol), Cells(firstRow, FinalCol))

            For Each rngCell In rngHeaderRow
                rngCell.BorderAround xlContinuous, xlMedium, xlColorIndexAutomatic
            Next rngCell

    Set rngCell = Range(Cells(firstRow - 1, firstCashAvailableCol), Cells(firstRow - 1, FinalCol)) '/ The extra "Cash made available" Header Cell
        rngCell.BorderAround xlContinuous, xlMedium, xlColorIndexAutomatic

    '/ Set column widths
    CurrentWS.Columns.AutoFit

    'This is that 10 from the very beginning, right?
    For col = firstCashAvailableCol To FinalCol
        Columns(col).ColumnWidth = colWidthCashAvailable
    Next col

End Sub

Overall, it's mostly cleaning up the variable names, putting in meaningful and descriptive comments and being consistent. I didn't see any methods that need approving, no extra loops or anything. I did wonder why the day and frequency sort lists had their own functions that seem static.

| improve this answer | |
\$\endgroup\$
  • 2
    \$\begingroup\$ Just a note. Whilst I can follow fairly well, for anyone else, it would be much clearer to use snippets and point to pieces of code and how you would do them differently, rather than re-write the code and force people to keep scrolling back and forth to figure out what you changed. \$\endgroup\$ – Kaz Dec 10 '15 at 19:31
  • \$\begingroup\$ Also thanks for the review, there are some good points in there. \$\endgroup\$ – Kaz Dec 10 '15 at 19:31
  • \$\begingroup\$ Also, range.column and .row return the first column/row of the specified range. \$\endgroup\$ – Kaz Dec 10 '15 at 19:32
  • \$\begingroup\$ Good, that would be a good thing to note in the comments of the code in case someone came by and decided no I need to find the first cell, then get the address. \$\endgroup\$ – Raystafarian Dec 10 '15 at 19:33

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.