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