Check Accounting Journal for Errors

Question

I wrote this sub in Excel VBA. I am a novice, but I was able to get my code to work how I wanted it to.

Unfortunately, I can see there is a lot of repetition, but it is too complex for me to figure out how to extract the duplicate if statements.

I am sure there is a lot of other issues with my code, but the repetitive if statements was what brought me to this site to look for help in refactoring.

This first section I just made it Option Explicit so I wouldn't mess up with variables. Then I declared some Public variables that I needed to use in a couple of modules.

The main sub is ErrorCheck which validates data in numerous ranges on the worksheet. Many of the if statements are repetitive, but they have enough differences like ranges and diff msgbox answers where I don't know how to extract as a separate function or sub.

Option Explicit
Public CalcState As Long
Public EventState As Boolean
Public PageBreakState As Boolean

Private Sub disable()
    With Application
        .DisplayAlerts = False
        .ScreenUpdating = False

        CalcState = .Calculation
        .Calculation = xlCalculationManual

        EventState = .EnableEvents
        .EnableEvents = False

        PageBreakState = Sheet2.DisplayPageBreaks
        Sheet2.DisplayPageBreaks = False
    End With
End Sub


Private Sub enable()
    With Application
        .DisplayAlerts = True
        .ScreenUpdating = True
        .Calculation = CalcState
        .EnableEvents = EventState
        Sheet2.DisplayPageBreaks = PageBreakState
    End With
End Sub

Sub ErrorCheck()

    'call disable routine to speed up macro
    disable

    On Error Resume Next
    'unprotect sheet to avoid any issues
    ActiveSheet.Unprotect "secret"

    'hide export in case changes were made
    Sheet2.Shapes("Rounded Rectangle 3").Visible = msoFalse

    'make sure there are at least a debit and credit entered
    Dim LastRow As Long
    LastRow = Cells(Rows.Count, 4).End(xlUp).Row
    If LastRow < 9 Then
        MsgBox ("Journal Entries require a minimum of 2 transactions")
        GoTo SafeExit
    End If

    'input item numbers in column C
    Dim ItemRng As Range
    Set ItemRng = Range("C8:C" & LastRow)
    Range("C8").value = 1
    ItemRng.DataSeries Type:=xlLinear, Step:=1, Trend:=False

    'make all debit and credit entries uppercase
    With Range("E8:E" & LastRow)
        .value = Evaluate("INDEX(UPPER(" & .Address(External:=True) & "),)")
    End With

    'get rid of all negative amounts
    With Range("F8:F" & LastRow)
        .value = Evaluate("INDEX(ABS(" & .Address(External:=True) & "),)")
    End With

    'check main fields are populated
    Dim MainRng As Range
    Dim rng As Range
    Set MainRng = ActiveSheet.Range("B1:B5, D2:D3, D8:F" & LastRow & ", J8:K" & LastRow)
    For Each rng In MainRng
        If rng.value = "" Then
            MsgBox (Cells(7, rng.Column) & " is a required field " & Chr(10) & "Check cell " & rng.Address(RowAbsolute:=False, ColumnAbsolute:=False))
            rng.Select
            GoTo SafeExit
        End If
        If Not Intersect(rng, Range("D8:D" & LastRow)) Is Nothing Then
            If IsError(Application.VLookup(Val(rng.value), Range("SAP_COA"), 1, False)) Then
                MsgBox "This is not a valid GL account" & Chr(10) & "Check cell " & rng.Address(RowAbsolute:=False, ColumnAbsolute:=False)
                rng.Select
                GoTo SafeExit
            End If
        End If
        If Not Intersect(rng, Range("E8:E" & LastRow)) Is Nothing Then
            If IsError(Application.VLookup(rng.value, Range("Indicator"), 1, False)) Then
                MsgBox "This is not a valid Debit/Credit indicator" & Chr(10) & "Check cell " & rng.Address(RowAbsolute:=False, ColumnAbsolute:=False)
                rng.Select
                GoTo SafeExit
            End If
        End If
        If Not Intersect(rng, Range("K8:K" & LastRow)) Is Nothing Then
            If IsError(Application.VLookup(Val(rng.value), Range("Code"), 1, False)) Then
                MsgBox "This is not a valid Company Code" & Chr(10) & "Check cell " & rng.Address(RowAbsolute:=False, ColumnAbsolute:=False)
                rng.Select
                GoTo SafeExit
            End If
        End If
    Next

    Dim RefRng As Range
    Dim GLRng As Range
    Dim CenterRng As Range
    Set GLRng = Range("D8:D" & LastRow)

    If Sheet2.CheckBox1.value = True Then
        For Each rng In GLRng
            If Left(rng.value, 1) <> 6 Then
                Set CenterRng = Range("Y" & rng.Row)
                If Not Application.WorksheetFunction.CountA(CenterRng) > 0 Then
                    MsgBox ("Please enter a profit center" & Chr(10) & "Check cell " & CenterRng.Address(RowAbsolute:=False, ColumnAbsolute:=False))
                    Application.ScreenUpdating = True
                    CenterRng.Select
                    GoTo SafeExit
                End If
            End If
            If Left(rng.value, 1) = 4 Or Left(rng.value, 1) = 5 Then
                Set RefRng = Range("M" & rng.Row & ":T" & rng.Row)
                If Not Application.WorksheetFunction.CountA(RefRng) > 0 Then
                    MsgBox ("Reference 1 or Reference 2 is required for P&L accounts")
                    Application.ScreenUpdating = True
                    RefRng.Select
                    GoTo SafeExit
                End If

                If Len(Range("M" & rng.Row).value) > 0 And Len(Range("M" & rng.Row).value) <> 4 Then
                    MsgBox "SubVendor and Master Vendor must be 4 digits." & Chr(10) & "Check cell " & Range("M" & rng.Row).Address(RowAbsolute:=False, ColumnAbsolute:=False)
                    Application.ScreenUpdating = True
                    Range("M" & rng.Row).Select
                    GoTo SafeExit
                End If

                If Len(Range("N" & rng.Row).value) > 0 And Len(Range("N" & rng.Row).value) <> 4 Then
                    MsgBox "SubVendor and Master Vendor must be 4 digits." & Chr(10) & "Check cell " & Range("N" & rng.Row).Address(RowAbsolute:=False, ColumnAbsolute:=False)
                    Application.ScreenUpdating = True
                    Range("N" & rng.Row).Select
                    GoTo SafeExit
                End If

                If Len(Range("Q" & rng.Row).value) > 0 Then
                    If Len(Range("Q" & rng.Row).value) <> 8 And Len(Range("Q" & rng.Row).value) <> 6 Then
                        MsgBox "Customer account number is 8 digits or SAP account number is 6 digits" & Chr(10) & "Check cell " & Range("Q" & rng.Row).Address(RowAbsolute:=False, ColumnAbsolute:=False)
                        Application.ScreenUpdating = True
                        Range("Q" & rng.Row).Select
                        GoTo SafeExit
                    End If
                End If

                If Len(Range("R" & rng.Row).value) > 0 Then
                    If Len(Range("R" & rng.Row).value) <> 8 And Len(Range("R" & rng.Row).value) <> 6 Then
                        MsgBox "Customer account number is 8 digits or SAP account number is 6 digits" & Chr(10) & "Check cell " & Range("R" & rng.Row).Address(RowAbsolute:=False, ColumnAbsolute:=False)
                        Application.ScreenUpdating = True
                        Range("R" & rng.Row).Select
                        GoTo SafeExit
                    End If
                End If

                If Len(Range("O" & rng.Row).value) > 0 Then
                    If IsError(Application.VLookup(Range("O" & rng.Row).value, Range("BU"), 1, False)) Then
                        MsgBox UCase(Range("O" & rng.Row).value) & " is not a valid Business Unit" & Chr(10) & "Check cell " & Range("O" & rng.Row).Address(RowAbsolute:=False, ColumnAbsolute:=False)
                        Application.ScreenUpdating = True
                        Range("O" & rng.Row).Select
                        GoTo SafeExit
                    End If
                End If

                If Len(Range("P" & rng.Row).value) > 0 Then
                    If IsError(Application.VLookup(Range("P" & rng.Row).value, Range("VD"), 1, False)) Then
                        MsgBox UCase(Range("P" & rng.Row).value) & " is not a valid Vendor Division" & Chr(10) & "Check cell " & Range("P" & rng.Row).Address(RowAbsolute:=False, ColumnAbsolute:=False)
                        Application.ScreenUpdating = True
                        Range("P" & rng.Row).Select
                        GoTo SafeExit
                    End If
                End If

                If Len(Range("S" & rng.Row).value) > 0 Then
                    If IsError(Application.VLookup(Range("S" & rng.Row).value, Range("Cus_Group"), 1, False)) Then
                        MsgBox UCase(Range("S" & rng.Row).value) & " is not a valid Customer Group" & Chr(10) & "Check cell " & Range("S" & rng.Row).Address(RowAbsolute:=False, ColumnAbsolute:=False)
                        Application.ScreenUpdating = True
                        Range("S" & rng.Row).Select
                        GoTo SafeExit
                    End If
                End If

                If Len(Range("T" & rng.Row).value) > 0 Then
                    If IsError(Application.VLookup(Range("T" & rng.Row).value, Range("Cus_Seg"), 1, False)) Then
                        MsgBox UCase(Range("T" & rng.Row).value) & " is not a valid Customer Segment" & Chr(10) & "Check cell " & Range("T" & rng.Row).Address(RowAbsolute:=False, ColumnAbsolute:=False)
                        Application.ScreenUpdating = True
                        Range("T" & rng.Row).Select
                        GoTo SafeExit
                    End If
                End If

                If Len(Range("Y" & rng.Row).value) > 0 Then
                    If IsError(Application.VLookup(Val(Range("Y" & rng.Row).value), Range("LOB_PC"), 1, False)) Then
                        MsgBox UCase(Range("Y" & rng.Row).value) & " is not a valid Profit Center for GL " & rng.value & Chr(10) & "Check cell " & Range("Y" & rng.Row).Address(RowAbsolute:=False, ColumnAbsolute:=False)
                        Application.ScreenUpdating = True
                        Range("Y" & rng.Row).Select
                        GoTo SafeExit
                    End If
                End If

            End If
            If Left(rng.value, 1) = 6 Then
                Set CenterRng = Range("V" & rng.Row)
                If Not Application.WorksheetFunction.CountA(CenterRng) > 0 Then
                    MsgBox ("Operating expense accounts require a cost center")
                    Application.ScreenUpdating = True
                    CenterRng.Select
                    GoTo SafeExit
                End If
            End If

            If Left(rng.value, 1) < 4 Then
                If Len(Range("Y" & rng.Row).value) > 0 Then
                    If IsError(Application.VLookup(Val(Range("Y" & rng.Row).value), Range("BS"), 1, False)) Then
                        MsgBox UCase(Range("Y" & rng.Row).value) & " is not a valid Profit Center for GL " & rng.value & Chr(10) & "Check cell " & Range("Y" & rng.Row).Address(RowAbsolute:=False, ColumnAbsolute:=False)
                        Application.ScreenUpdating = True
                        Range("Y" & rng.Row).Select
                        GoTo SafeExit
                    End If
                End If
            End If
        Next
    End If

    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
        MsgBox ("Debits and Credits do not equal")
        GoTo SafeExit
    End If

    Sheet2.Shapes("Rounded Rectangle 3").Visible = msoTrue

    Sheet2.Columns.AutoFit
    Range("A8").Select

    MsgBox ("No errors found")

SafeExit:
    enable
    ActiveSheet.Protect Password:="secret", AllowFormattingColumns:=True, AllowFormattingRows:=True

End Sub

Answer 1

Must Change:

• Use of unqualified Range.
  • Example in your code: Range("D8:D" & LastRow)
  • What this means: Unqualified means you didn't state the parent object. This is bad because the VB Editor will silently make assumptions for you. For example, if you just say Range(), the VBE assumes you mean ThisWorkbook.Activesheet.Range(). If you take the time to qualify every reference in the future, you will avoid bewildering errors where you have to guess what the VBE assumed for you.
  • Fix: You already know how to do it, use With blocks. For example, if you're talking about the sheet with the codename Sheet2, you could fully qualify the reference using With in the following three ways:
    • With ThisWorkbook.Worksheets("Sheet2"), assuming the sheet with codename Sheet2 is called "Sheet2" in your workbook.
    • With ThisWorkbook.Worksheets(2), assuming the sheet with codename Sheet2 is the second sheet in your workbook.
    • With Sheet2, my favorite, referencing the sheet by its VBE codename. This means that if you change the sheet's name or reorder them, your macro will still work. I recommend giving Sheet2 a new codename though. It looks like you're working with an accounting journal, so maybe Journal?

Good to Change

• Your repeated reads of the worksheet

  • Example in your code: For Each rng In MainRng, If rng.value
  • What this means: Every time you ask VBA to read or write a value to a worksheet, it is expensive performance-wise. If you're going to be doing it repeatedly, it's wise to save the sheet values to memory via an array.

  • Fix:

    'Use a better name, I'm just illustrating the concept
    Dim arrRangeToArray() as Variant 
    arrRangeToArray = rng.Value
    

    This will give you rng in two-dimensional, 1-based array form. You can work with these values much less expensively than when you read the worksheet directly.

    • Two dimensional array means it has both rows and columns
    • 1-based array means the first value will have the coordinates 1,1, whereas a 0-based array would be 0,0.

    Before you were using For Each rng In MainRng, If rng.value. To cycle through all the values in an array, you would do:

    Dim lngColumnIndex as Long
    'Columns are the second dimension, hence ",2"
    For lngColumnIndex = LBound(arrRangeToArray,2) to UBound(arrRangeToArray,2)
        Dim lngRowIndex as Long
        'Rows are the first dimension, hence ",1"
        For lngRowIndex = LBound(arrRangeToArray,1) to UBound(arrRangeToArray,1)
            If arrRangeToArray(lngRowIndex, lngColumnIndex) = "" Then
                'Whatever
            End If
        Next lngColumnIndex
    Next lngRowIndex
    

• Using VLookup to check for existence instead of a dictionary

  • Example in your code: If IsError(Application.VLookup(rng.value, Range("Indicator"), 1, False))
  • What this means: WorksheetFunctions like VLookup, Count, etc. are useful but expensive. As far as checking for existence in a range, you could save the range to a dictionary instead and then use the dictionary's .Exists() function.

  • Fix: First, go to the VBE's Tools menu, References, and check the box next to Microsoft Scripting Runtime. Then building on the array code from before:

    'Initialize dictionary
    Dim dictRange As Scripting.Dictionary
    Set dictRange = CreateObject("Scripting.Dictionary")
    dictRange.comparemode = vbTextCompare
    
    Dim lngColumnIndex as Long
    For lngColumnIndex = LBound(arrRangeToArray,2) to UBound(arrRangeToArray,2)
        Dim lngRowIndex as Long
        For lngRowIndex = LBound(arrRangeToArray,1) to UBound(arrRangeToArray,1)
            'Add range items to dictionary
            dictRange.Add Key:=arrRangeToArray(lngRowIndex, lngColumnIndex), Item:=arrRangeToArray(lngRowIndex, lngColumnIndex)
        Next lngColumnIndex
    Next lngRowIndex
    
    'Check if item exists in range
    If True = dictRange.Exists("value you're checking for here")
    

Conclusion

There's plenty of other things you could improve, but you're doing fine. I want to keep this review manageable for you - these three things are the most important in my opinion.

Answer 2

@puzzlepiece87 already gave some good suggestions. I would like to add a few of my own. I will start with some general programming guidelines which are always good to follow; then I will give some examples how to apply them to your code; finally, I will make some more suggestions that came to my mind.

General Programming Guidelines

1. One of the most useful, and hardest to get right, guidelines for programming is the Single Responsibility Principle (SRP). In short, it says that every unit of your code should do one thing and only one. The exact formulation is a bit more sophisticated but this description is a good approximation. The primary benefit is that following this principle makes your code much more readable. In particular, you can substitute comments, which tend to get stale over time, into procedure and function names.

2. Somewhat related to the SRP is the DRY principle. (Don't repeat yourself.) More practically, do not write very similar code twice without thinking about a way to deal with the situation by a bit more abstracting.

3. The second best advice is to give good names to variables and procedures. This helps readability again. In general, longer more descriptive names are better than short cryptic ones.

4. For readability, and hence maintainability, GoTo is a statement from hell. When it is used outside an error handling statement, it either does something terrible or something that could be more cleanly expressed by another construct.

5. Errors are raised for a reason. They usually tell you that something is broken. So, do not disable them for extended periods.

How these Guidelines Relate to your Code

Let me start with the naming. This is actually not too bad. As already stated by @puzzlepiece87, you could rename the document module Sheet2 but otherwise you seem to try to use meaningful names.

One thing you might want to do is follow a widely used case convention for names in VBA. That would be camelCase for variables and PascalCase for Functions and Procedures. This makes distinguishing the different types of constructs rather easy.

One other thing regarding names: you can give names to ranges on spreadsheets. This allows you to refer to them in the VBA code like in Range("MyRange"). This does not only improve readability, but also makes your code more immune to failure due to changes in the sheet's design, e.g. adding a column. (Oh, I just realized you actually do that for some ranges.) Note that you can actually define named ranges dynamically via the names dialog. (You can use OFFSET.) Unfortunately, this feature seems to crash Excel quite rather too often.

Now, let me come to your use of GoTo. This is actually not the sort of GoTo that is horrifically bad but it basically hints at a SRP violation. Your procedure has the responsibility to disable updating, unlocking the sheet and the actual work it does. You can easily avoid using GoTo by extracting the entire work into a procedure that is called by an enclosing one responsible for the logistics. The surrounding procedure would look something like this.

Public Sub ErrorCheck()
    Disable
    UnprotectSheet ActiveSheet, "secret"
    DoActualWork
    ProtectSheet ActiveSheet, "secret"
    Enable
End Sub

Btw, never put anything that should really be secret in code. (Here, it does not seem too bad since it is only the sheet protection which is not secure anyway.)

Admittedly, introducing separate procedures for protecting and unprotecting the sheet is a bit overkill, but in principle you could take further measures in these procedures relating to the sheet in question.

Having the procedure above allows you to simply use Exit Sub instead of GoTo SafeExit in DoActualWork. Moreover the responsibilities got separated so that it is clearer what each part is doing.

Regarding the SRP, there is more to say about you procedure. It actually does a lot of different things. One good indication what would be good to pull into its own procedure or function is when you feel the urge to insert a comment as heading. You could literally turn your comments into procedure names like MakeDebitAndCreditEntriesUppercase and pull the code into its own procedure. Then, the main procedure reads like a higher level description of what is going on; the details are in the implementations of the extracted procedures. When you come back to your code after a few months, you will thank yourself for doing this.

You could abstract conditions away into a function like

Private Function IsValidRange(evaluationRange As Excel.Range, interdectionRange As Excel.Range, referenceRangeName As String)
     IsValidRange = (Not Application.Intersect(evaluationRange,interdectionRange) Is Nothing) Then
        If IsError(Application.VLookup(evaluationRange.value, Range(referenceRangeName), 1, False)) Then
End Function

In a similar fashion you can try to tackle all those Len(someRange)>0 conditions.

Since you generally do the same thing after finding an error, just with another error text or range to select, you can also put tin in its own private procedure, which you can call every time one of the tests returns true.

Some Further Suggestions

As already stated by @puzzlepiece87, it is always a good idea to state things explicitly instead of letting the VBE infer it. That also holds for the accessibility of procedures. Your procedure is implicitly public; you should simply state that in the code by explicitly applying the modifier.

The basic problem that led you to your usage of GoTo was probably that you have to do some clean up after your processing. There is a neat little trick coming from C++ you can use to handle such situations, the RAII principle (Resource Allocation is Instantiation). This mean that you couple acquiring and releasing a resource or a temporary change of settings with the creation and destruction of an object. This works in VBA, in contrast to Java or C#, because objects in VBA have a well-defined lifetime.

To apply this principle, you insert a new class module. Let us call it UpdateDisabler. Then you move enable, disable and the fields they use into the class as private members. Finally you add a Class_Initialize procedure calling disable and a Class_Terminate procedure calling enable.

Now, if you want to disable updating, you create a new instance of UpdateDisabler and assign it to a variable. Creating the instance makes VBA call Class_Initialize and hence disable. Once the variable goes out of scope, more precisely, once no object in scope holds a reference to the instance, VBA automatically calls Class_Terminate and hence enable. This way, the settings get enabled again no matter what.

Answer 3

To not duplicate the good advice from puzzlepiece87, I would suggest also to look for pieces of code that look almost the same, with some minor changes (which can be passed as arguments to the function).

For instance:

If Len(Range("Y" & rng.Row).value) > 0 Then
    If IsError(Application.VLookup(Val(Range("Y" & rng.Row).value), Range("BS"), 1, False)) Then
        MsgBox UCase(Range("Y" & rng.Row).value) & " is not a valid Profit Center for GL " & rng.value & Chr(10) & "Check cell " & Range("Y" & rng.Row).Address(RowAbsolute:=False, ColumnAbsolute:=False)
        Application.ScreenUpdating = True
        Range("Y" & rng.Row).Select
        GoTo SafeExit
    End If
End If

Can be extracted to:

Sub ValidateValue(columnId as String, message as String, comparissonValue as Integer, lookupRange as String)
    If Len(Range(columnID & rng.Row).value) > comparissonValue Then
        If IsError(Application.VLookup(Val(Range(columnId & rng.Row).value), Range(lookupRange), 1, False)) Then
            MsgBox message
            Application.ScreenUpdating = True
            Range(columnId & rng.Row).Select
            Exit Sub
        End If
    End If
End sub

And called from all the places you want. The construction of the message itself (which seems elaborate enough) can be made into another function, using a similar approach, and called from within this sub or from the main method, and passed as an argument (which is the approach I followed here).

What I want to stress out is that there's a lot of repetition here, and it looks more difficult to reuse that it really is. With some good parameter naming, and the better understanding of the business you should have, it shouldn't be that difficult. And as you extract more things, you'll see how things start to look simpler and to make more sense.

And yes, a side effect of this is having less lines of code. But for me this is not just about real estate. For me the idea behind extracting common functionality is more about simplifying your code and making it more legible, because as you find more common things that can be made into small subs or functions, your are clarifying what each part of your code does. For an external person, it would be easier to understand it. And it's also about reducing the likelihood of having bugs, because all the logic related to a single task is located in only one place, ideally very well named. So when you need to fix or modify anything related to that a task in your system, you know where to look at, and you apply fixes/changes in just one place (which is less prone to human error than having to do it in several places scattered all over the place, which might not be very visible or easy to find).

By the way, after you extracted the common code to some smaller functions and subs, you'll also see that applying all other advice is far easier!