Check Accounting Journal for Errors - Revision

Question

This is my revised code from my original question Check Accounting Journal for Errors

I was able to use the information provided in the answers to that question to get my code cleaned up removing duplication and utilizing better coding practices. I want to make sure I didn't miss anything and would appreciate a final review to ensure that there isn't any remaining problems that need attention.

 Option Explicit
 Public CalcState As Long
 Public PageBreakState As Boolean
 Public Sub ProcessJEValidations()
 Disable
 HideExportButton
 CheckForEntries
 InputItemNumbers CreateRngFromCol("Item_Number")
 ConvertDebitsAndCreditsToUppercase CreateRngFromCol("DR_CR__Indicator")
 CheckRequiredFields
 NoNegativeAmounts CreateRngFromCol("Amount_in_Doc_Currency")
 GLDependencies
 CheckBalance
 FinishingTouch
 SafeExit
 MsgBox ("No errors found")
 End Sub
 Private Sub Disable()
 'speed up macro
 With Application
 .DisplayAlerts = False
 .ScreenUpdating = False
 CalcState = .Calculation
 .Calculation = xlCalculationManual
 .EnableEvents = False
 PageBreakState = Sheet2.DisplayPageBreaks
 Sheet2.DisplayPageBreaks = False
 End With
 UnprotectSheet
 End Sub
 Private Sub UnprotectSheet()
 'unprotect sheet to avoid any issues with editing
 On Error Resume Next
 Sheet2.Unprotect "secret"
 ThisWorkbook.Unprotect "secret"
 End Sub
 Private Sub Enable()
 With Application
 .DisplayAlerts = True
 .ScreenUpdating = True
 .Calculation = CalcState
 .EnableEvents = True
 Sheet2.DisplayPageBreaks = PageBreakState
 End With
 End Sub
 Private Sub SafeExit()
 Enable
 On Error Resume Next
 Sheet2.Protect Password:="secret", AllowFormattingColumns:=True, AllowFormattingRows:=True
 ThisWorkbook.Protect Password:="secret", Structure:=True, Windows:=False
 End Sub
 Public Sub Timer(Optional dummy As Byte)
 On Error Resume Next
 With Sheet2.Label1
 .Visible = False
 End With
 End Sub
 Private Sub HideExportButton()
 'hide export in case changes were made
 Sheet2.Shapes("Rounded Rectangle 3").Visible = msoFalse
 End Sub
 Private Sub CheckForEntries()
 'make sure there are at least a debit and credit entered
 If LastRow < 9 Then
 MessageUser Sheet2.Range("A8"), "Journal Entries require a minimum of 2 transactions"
 End If
 End Sub
 Private Sub InputItemNumbers(itemNumRng As Range)
 'input item numbers in column C
 Sheet2.Cells(8, itemNumRng.Column) = 1
 itemNumRng.DataSeries Type:=xlLinear, Step:=1, Trend:=False
 End Sub
 Private Sub ConvertDebitsAndCreditsToUppercase(debitCreditRng As Range)
 'make all debit and credit entries uppercase
 debitCreditRng = Evaluate("INDEX(UPPER(" & debitCreditRng.Address(External:=True) & "),)")
 End Sub
 Private Sub NoNegativeAmounts(amountRng As Range)
 'get rid of all negative amounts
 amountRng = Evaluate("INDEX(ABS(" & amountRng.Address(External:=True) & "),)")
 End Sub
 Private Function CreateRngFromCol(namedRange As String) As Range
 Dim rngCol As Long
 rngCol = Range(namedRange).Column
 Set CreateRngFromCol = Range(Cells(8, rngCol), Cells(LastRow, rngCol))
 End Function
 Private Function LastRow()
 LastRow = Sheet2.Cells(Sheet2.Rows.count, 4).End(xlUp).Row
 End Function
 Private Sub CheckRequiredFields()
 'check required fields are populated and data for GL, Company Code, and Indicator columns is valid
 Dim lookupRng As String
 Dim rng As Range
 Dim rngToCheck As Range
 Set rngToCheck = Range(Range("Header_Fields").Address & ", " & Range(CreateRngFromCol("GL_Account_Number"), CreateRngFromCol("Amount_in_Doc_Currency")).Address & ", " & Range(CreateRngFromCol("Line_Item_Text"), CreateRngFromCol("Company_Code")).Address)
 For Each rng In rngToCheck
 lookupRng = IIf(rng.Row < 6, rng.Offset(, -1), Cells(7, rng.Column))
 If rng = "" Then _
 MessageUser rng, (Replace(Trim(Replace(lookupRng, ":", "")), Chr(10), " ") & " is a required field " & Chr(10) & "Check cell " & rng.Address(RowAbsolute:=False, ColumnAbsolute:=False))
 If rng.Row > 7 Then
 lookupRng = Switch(rng.Column = Range("GL_Account_Number").Column, "SAP_COA", rng.Column = Range("DR_CR__Indicator").Column, "Indicator", rng.Column = Range("Amount_in_Doc_Currency").Column, "", rng.Column = Range("Line_Item_Text").Column, "", rng.Column = Range("Company_Code").Column, "Code")
 If lookupRng <> "" Then ValidateFields Sheet2.Cells(7, rng.Column), rng, Range(lookupRng)
 End If
 Next rng
 End Sub
 Private Sub GLDependencies()
 'if checkbox is marked then must validate profit centers and reference fields
 If Sheet2.CheckBox1.value = True Then
 Dim rng As Range
 Dim glRng As Range: Set glRng = CreateRngFromCol("GL_Account_Number")
 For Each rng In glRng
 Select Case Left(rng, 1)
 Case 1 To 3
 ValidateFields "Profit Center", Cells(rng.Row, CreateRngFromCol("Profit_Center").Column), Range("BS")
 Case 4, 5
 ValidateFields "Profit Center", Cells(rng.Row, CreateRngFromCol("Profit_Center").Column), Range("LOB_PC")
 RefFields rng
 Case 6
 If Not Application.WorksheetFunction.CountA(Cells(rng.Row, CreateRngFromCol("Cost_Center").Column)) > 0 Then _
 MessageUser Cells(rng.Row, CreateRngFromCol("Cost_Center").Column), "Operating expense accounts require a cost center"
 Case 7
 End Select
 Next rng
 End If
 End Sub
 Private Sub MessageUser(rng As Range, msg As String)
 MsgBox msg
 SafeExit
 rng.Select
 End
 End Sub
 Private Sub ValidateFields(str As String, lookupValue As Range, lookupRng As Range)
 If IsError(Application.VLookup(lookupValue, lookupRng, 1, False)) Then _
 MessageUser lookupValue, "Please enter a valid " & Replace(Trim(Replace(str, "_", " ")), Chr(10), " ") & Chr(10) & "Check cell " & lookupValue.Address(RowAbsolute:=False, ColumnAbsolute:=False)
 End Sub
 Private Sub RefFields(rng As Range)
 Dim arr As Variant
 Dim item As Variant
 Dim count As Integer
 Dim refType As String
 Dim refRngOffset As Range
 Dim refRng As Range: Set refRng = Intersect(rng.EntireRow, Range("Reference_Fields"))
 If Not Application.WorksheetFunction.CountA(refRng) > 0 Then _
 MessageUser refRng, "Ref 1 or Ref 2 is required for P&L accounts"
 arr = refRng
 count = 1
 For Each item In arr
 If Not IsEmpty(item) Then
 Set refRngOffset = refRng.Resize(, 1).Offset(, count - 1)
 Select Case count 'count indicates the column position within the reference fields
 Case 1 To 3
 refType = Switch(count = 1, "Sub Vendor", count = 2, "Master Vendor", count = 3, "Payee")
 If Len(item) <> 4 Then _
 MessageUser refRngOffset, refType & " must be 4 digits long" & Chr(10) & "Check cell " & refRngOffset.Address(RowAbsolute:=False, ColumnAbsolute:=False)
 Case 4, 5, 8, 9
 refType = Switch(count = 4, "BU", count = 5, "VD", count = 8, "Cus_Group", count = 9, "Cus_Seg")
 ValidateFields refType, Cells(rng.Row, refRngOffset.Column), Range(refType)
 Case 6, 7
 refType = Switch(count = 6, "Customer", count = 7, "Master Customer")
 If Len(item) <> 6 And Len(item) <> 8 Then _
 MessageUser refRngOffset, "Customer account must be 6 or 8 digits long (SAP/Impulse)" & Chr(10) & "Check cell " & refRngOffset.Address(RowAbsolute:=False, ColumnAbsolute:=False)
 End Select
 End If
 count = count + 1
 Next item
 End Sub
 Private Sub CheckBalance()
 With Sheet2
 .Range("I2").value = "Debits"
 .Range("I3").value = "Credits"
 .Range("I4").value = "Total"
 .Range("J2").value = Round(Application.WorksheetFunction.SumIf(.Range("E8:E" & LastRow), "D", .Range("F8:F" & LastRow)), 2)
 .Range("J3").value = Round(Application.WorksheetFunction.SumIf(.Range("E8:E" & LastRow), "C", .Range("F8:F" & LastRow)) * -1, 2)
 .Range("J4").value = Application.WorksheetFunction.Sum(.Range("J2:J3"))
 With .Range("I2:J4").Interior
 .Pattern = xlSolid
 .PatternColorIndex = xlAutomatic
 .ThemeColor = xlThemeColorAccent1
 .TintAndShade = 0.799981688894314
 .PatternTintAndShade = 0
 End With
 .Range("I2:J4").BorderAround xlContinuous, xlMedium
 .Range("J2:J4").Style = "Comma"
 If Not .Range("J4").value = 0 Then
 MessageUser .Range("I4:J4"), "Debits and Credits do not equal"
 End If
 End With
 End Sub
 Private Sub FinishingTouch()
 With Sheet2
 .Shapes("Rounded Rectangle 3").Visible = msoTrue
 .Columns.AutoFit
 .Label1.Visible = False
 .Range("A8").Select
 End With
 End Sub
 Public Sub ClearForm()
 Disable
 If MsgBox("Are you sure you want to reset and clear the template?" & Chr(10) & "You will not be able to Undo this action.", vbYesNo) = vbNo Then Exit Sub
 Dim lRow As Long
 lRow = ActiveSheet.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
 If lRow < 8 Then lRow = 8
 With Sheet2
 .Range("B1:B5, D1:D5, E3, A8:AG" & lRow).ClearContents
 .Range("I2:J4").Clear
 .Range("B1").value = "8190"
 .Range("B2").value = "USD"
 .Range("B3").value = Now()
 .Range("D2").value = "SA"
 .CheckBox1.value = True
 .Shapes("Rounded Rectangle 3").Visible = msoFalse
 .Columns.AutoFit
 .Range("A8").Select
 End With
 SafeExit
 End Sub

Answer 1

The name of Disable isn't really what it's doing. More you're turning off application properties. Same for Enable.

---

 On Error Resume Next
 Sheet2.Unprotect "secret"
 ThisWorkbook.Unprotect "secret"

Seems like maybe you'd check for protection instead of just eating errors up.

 On Error Resume Next
 Sheet2.Protect Password:="secret", AllowFormattingColumns:=True, _ 
 AllowFormattingRows:=True
 ThisWorkbook.Protect Password:="secret", Structure:=True, Windows:=False

Here we're eating errors again, what could go wrong? And why wouldn't you want to know it went wrong?

---

On these processes

Private Sub ConvertDebitsAndCreditsToUppercase(debitCreditRng As Range)
Private Sub NoNegativeAmounts(amountRng As Range)

you're passing a range to alter the contents of the range at the range. It would be faster to take the values off the sheet change them and then put them back. You could also get rid of those EVALUATEs.

---

In your LastRow function you've hardcoded it to Sheet2. Why not allow an argument and use that?

Private Function LastRow(ByVal targetSheet As Worksheet) As Long
 LastRow = targetSheet.Cells(targetSheet.Rows.count, 4).End(xlUp).Row
End Function

---

Speaking of arguments, you're pretty much sending all your arguments ByRef. You want to use ByVal whenever you can. Quoting RubberDuck -

Parameters are passed by reference unless specified otherwise, which can be confusing and bug-prone. Prefer passing parameters by value and specify ByRef explicitly when passing parameters by reference.

and

A parameter that is passed by reference and isn't assigned a new value/reference, could be passed by value instead.

---

Speaking of doing things explicitly, every single time you use range or cell without giving it a sheet, it's implicitly using ActiveSheet. Try to always be as explicit as possible.

---

Variable names - give your variables meaningful names. What's a rng or a glRng? Is that generalLedgerAccounts instead? Also try to follow standard VBA naming conventions have camelCase for local variables and PascalCase for other variables and names.

---

Const

I see a few strings being used

• "GL_Account_Number" - 3
• "Profit_Center" - 2
• "Amount_in_Doc_Currency" - 3
• "DR_CR__Indicator" - 2
• "Cost_Center" - 2

With things like these, you might want to put them into a variable so that you only have to change the variable if the names ever change. And since they are static most of the time, you can make them constant variables:

Const PCENTER As String = "Profit_Center"
Const CCENTER As String = "Cost Center"
Const GLAN As String = "GL_Account_Number"

Put these at the top of the module and all your functions have access to them.