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