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
1 Answer 1
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.
-
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– Kaz2015年12月10日 19:31:18 +00:00Commented Dec 10, 2015 at 19:31
-
\$\begingroup\$ Also thanks for the review, there are some good points in there. \$\endgroup\$Kaz– Kaz2015年12月10日 19:31:35 +00:00Commented Dec 10, 2015 at 19:31
-
\$\begingroup\$ Also,
range.column
and.row
return the first column/row of the specified range. \$\endgroup\$Kaz– Kaz2015年12月10日 19:32:32 +00:00Commented 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\$Raystafarian– Raystafarian2015年12月10日 19:33:18 +00:00Commented Dec 10, 2015 at 19:33
.Activate
s? \$\endgroup\$Cvar
\$\endgroup\$