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
asked Dec 8, 2015 at 13:48
\$\endgroup\$
11
  • 1
    \$\begingroup\$ Is there a reason you need any of those .Activates? \$\endgroup\$ Commented Dec 8, 2015 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\$ Commented Dec 8, 2015 at 17:28
  • \$\begingroup\$ @Raystafarian Need? No. But I prefer not to make assumptions I don't have to. \$\endgroup\$ Commented Dec 9, 2015 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\$ Commented Dec 10, 2015 at 19:24
  • \$\begingroup\$ The thing is, say you're working with searchrange or tablerange, they are already defined as that sheet. \$\endgroup\$ Commented Dec 10, 2015 at 19:25

1 Answer 1

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.

answered Dec 10, 2015 at 18:56
\$\endgroup\$
4
  • 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\$ Commented Dec 10, 2015 at 19:31
  • \$\begingroup\$ Also thanks for the review, there are some good points in there. \$\endgroup\$ Commented Dec 10, 2015 at 19:31
  • \$\begingroup\$ Also, range.column and .row return the first column/row of the specified range. \$\endgroup\$ Commented Dec 10, 2015 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\$ Commented Dec 10, 2015 at 19:33

Your Answer

Draft saved
Draft discarded

Sign up or log in

Sign up using Google
Sign up using Email and Password

Post as a guest

Required, but never shown

Post as a guest

Required, but never shown

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.