1
\$\begingroup\$

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
\$\endgroup\$
0
\$\begingroup\$

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.

\$\endgroup\$

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.