OK, so all of this code is working for me, but I am wondering, and wanting to learn, if there are better or more efficient ways of doing the things I have in the below.
I am not experiencing slow processing or anything like that now, just trying to learn as I go here. I know there is a lot of unique data points in here and you don't have full context of what is going on, so I realize any feedback may be limited because of that. I have a lot of notes in here too that are for me in the future, so obviously ignore those.
Thanks for any feedback or assistance you may offer.
I am not experiencing slow processing or anything like that now, just trying to learn as I go here. I know there is a lot of unique data points in here and you don't have full context of what is going on, so I realize any feedback may be limited because of that. I have a lot of notes in here too that are for me in the future, so obviously ignore those.
Thanks for any feedback or assistance you may offer.
Code:
Sub RecordValueCheck()
'UPI = Unique Payable Identifer - from 2100 record field [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=3]#3[/URL]
'TPA = Total Payable Amount - from 2100 record field [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=5]#5[/URL]
'ITA = Invoice Total Amount - from 3000 recrod field [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=8]#8[/URL]
'CSPR = Count Submitted Payable Request - from 5000 record field [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=2]#2[/URL]
'T2100Count = A Counter for the number of time 2100 records show up
'RLN = Remittance Line number - from 3000 records field [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=4]#4[/URL]
'Rng = Range of the Cells to be checked
Dim Cell As Range, Cell2 As Range, Cell3 As Range, UPI As Range, i As Integer
Dim ErrorCount As Integer, TPA As Integer, ITA As Integer, ITACell As Range, TPACell As Range
Dim CSPR As Integer, CSPRCell As Range, T2100Count As Integer
Dim RLN As Integer, RLNCell As Range, RLNCount As Integer
Dim Rng As Range, Dn As Range, nRng As Range
Dim nR As Range, Rng1 As Range, c As Long, R As Range
Const num = 2100
Set Rng = Range(Range("B23"), Range("B" & Rows.Count).End(xlUp))
Application.EnableEvents = False
Application.ScreenUpdating = False
Worksheets("PIF Checker Output - Horz").Activate
ErrorCount = 0
' ****************************************************************
'Start Field [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=4]#4[/URL] for 3000 records Check
'Check to make sure that for any 3000 records they have a unique Remittance Line Number
'The count should always start with 1 and be sequential
For Each Dn In Rng
If Dn.Value = num Then
If nRng Is Nothing Then Set nRng = Dn Else Set nRng = Union(nRng, Dn)
End If
Next Dn
For Each Dn In nRng
c = 1
Do While Dn.Offset(c) = 3000
If Rng1 Is Nothing Then Set Rng1 = Dn.Offset(c) Else Set Rng1 = Union(Rng1, Dn.Offset(c))
c = c + 1
Loop
Next Dn
For Each nR In Rng1.Areas
c = 0
For Each R In nR
c = c + 1
If Not R.Offset(, 3).Value = c Then
ErrorCount = ErrorCount + 1
R.Offset(, 3).Interior.Color = vbRed
R.Offset(, 3).Font.Color = vbYellow
R.Offset(, 3).Font.Bold = True
End If
Next R
Next nR
'End Field [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=4]#4[/URL] for 3000 records Check
' ****************************************************************
'Start Field [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1]#1[/URL] Check
'Check to make sure all values in Field [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1]#1[/URL] are valid
With ThisWorkbook.Worksheets("PIF Checker Output - Horz")
For Each Cell In Rng
If Cell.Value <> 1000 And Cell.Value <> 2100 And Cell.Value <> 3000 And Cell.Value <> 5000 Or Len(Cell.Value) <> Cells(5, 2).Value Then
ErrorCount = ErrorCount + 1
Cell.Interior.Color = vbRed
Cell.Font.Bold = True
Cell.Font.Color = vbYellow
End If
Next
'End Field [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1]#1[/URL] Check
' ****************************************************************
'Start Field [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1]#1[/URL] for 5000 Record Count Check
'Check to see if the Count of Submitted Payable Requests (2100 records) matches this field [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=2]#2[/URL] in the 5000 recrod
'Using T2100Count and CSPR as variables
'Also checks the Payable End Date for the 2100 Records to make sure they are set for after today's date.
T2100Count = 0
For Each Cell In Rng
If Cell.Value = 2100 Then
T2100Count = T2100Count + 1
If Cell.Offset(0, 5).Value <> "USD" Then
ErrorCount = ErrorCount + 1
Cell.Offset(0, 5).Interior.Color = vbRed
Cell.Offset(0, 5).Font.Bold = True
Cell.Offset(0, 5).Font.Color = vbYellow
ElseIf DateSerial(Right((Cell.Offset(0, 7).Value), 4), Left((Cell.Offset(0, 7).Value), 2), Mid((Cell.Offset(0, 7).Value), 3, 2)) < Date Then
ErrorCount = ErrorCount + 1
Cell.Offset(0, 7).Interior.Color = vbRed
Cell.Offset(0, 7).Font.Bold = True
Cell.Offset(0, 7).Font.Color = vbYellow
End If
ElseIf Cell.Value = 5000 Then
CSPR = Cell.Offset(0, 1).Value
Set CSPRCell = Cell.Offset(0, 1)
End If
Next
If T2100Count <> CSPR Then
ErrorCount = ErrorCount + 1
CSPRCell.Interior.Color = vbRed
CSPRCell.Font.Bold = True
CSPRCell.Font.Color = vbYellow
End If
'End Field [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1]#1[/URL] 5000 Record Check
' ****************************************************************
'Start Field [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=2]#2[/URL] Check
'Check to make sure that all values in Field [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=2]#2[/URL] are set to "1.0" as that is required.
For Each Cell In Rng
If Cell.Value = 1000 Or Cell.Value = 2100 Or Cell.Value = 3000 Then
Set Cell2 = Cell.Offset(0, 1)
If Cell2.Value <> "1.0" Or Len(Cell2.Value) <> Cells(5, 3).Value Then
ErrorCount = ErrorCount + 1
Cell2.Interior.Color = vbRed
Cell2.Font.Bold = True
Cell2.Font.Color = vbYellow
End If
ElseIf Cell.Value = 5000 Or Cell.Value = "5000" Then
Application.EnableEvents = True
Application.ScreenUpdating = True
'Exit Sub
End If
Next
'End Field [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=2]#2[/URL] Check
' ****************************************************************
' ****************************************************************
'Start Field [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=5]#5[/URL] ,8 Check
'Check to see that the total of the Invoice amounts is equal to the Total Payable Amount
'Using TPA and ITA as variables
For Each Cell In Rng
'Get the TPA amount from field [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=5]#5[/URL] , column-F
If Cell.Value = 2100 Then
TPA = Cell.Offset(0, 4).Value
ITA = 0
Set Cell2 = Cell.Offset(1, 0)
i = 1
Do While Cell2.Value = 3000
ITA = Cell2.Offset(0, 7).Value + ITA
i = i + 1
Set Cell2 = Cell.Offset(i, 0)
Loop
If ITA = TPA Then
Else
ErrorCount = ErrorCount + 1
Cell.Offset(0, 4).Interior.Color = vbRed
Cell.Offset(0, 4).Font.Bold = True
Cell.Offset(0, 4).Font.Color = vbYellow
End If
ElseIf Cell.Value = 5000 Then
Application.EnableEvents = True
Application.ScreenUpdating = True
End If
Next
'End Field [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=5]#5[/URL] ,8 Check
' ****************************************************************
'Start Field [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1]#1[/URL] 6 for 2100 records Check
'Check to make sure the value is either a Yes or No
For Each Cell In Rng
If Cell.Value = 2100 Then
If Cell.Offset(0, 15).Value <> "YES" And Cell.Offset(0, 15).Value <> "Yes" And Cell.Offset(0, 15).Value <> "NO" And Cell.Offset(0, 15).Value <> "No" Then
ErrorCount = ErrorCount + 1
Cell.Offset(0, 15).Interior.Color = vbRed
Cell.Offset(0, 15).Font.Bold = True
Cell.Offset(0, 15).Font.Color = vbYellow
End If
End If
Next
'End Field [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1]#1[/URL] 6 for 2100 records Check
' ****************************************************************
'Start Field #'s 18-20 and 32-34 Check
'Check to make sure Fields 18-20 and 32-34 are always blank, they are reserved for future use.
For Each Cell In Rng
If Len(Cell.Offset(0, 17).Value) <> Cells(10, 19).Value Then
ErrorCount = ErrorCount + 1
Cell.Offset(0, 17).Interior.Color = vbRed
Cell.Offset(0, 17).Font.Bold = True
Cell.Offset(0, 17).Font.Color = vbYellow
End If
If Len(Cell.Offset(0, 18).Value) <> Cells(10, 19).Value Then
ErrorCount = ErrorCount + 1
Cell.Offset(0, 18).Interior.Color = vbRed
Cell.Offset(0, 18).Font.Bold = True
Cell.Offset(0, 18).Font.Color = vbYellow
End If
If Len(Cell.Offset(0, 19).Value) <> Cells(10, 19).Value Then
ErrorCount = ErrorCount + 1
Cell.Offset(0, 19).Interior.Color = vbRed
Cell.Offset(0, 19).Font.Bold = True
Cell.Offset(0, 19).Font.Color = vbYellow
End If
If Len(Cell.Offset(0, 31).Value) <> Cells(10, 33).Value Then
ErrorCount = ErrorCount + 1
Cell.Offset(0, 31).Interior.Color = vbRed
Cell.Offset(0, 31).Font.Bold = True
Cell.Offset(0, 31).Font.Color = vbYellow
End If
If Len(Cell.Offset(0, 32).Value) <> Cells(10, 33).Value Then
ErrorCount = ErrorCount + 1
Cell.Offset(0, 32).Interior.Color = vbRed
Cell.Offset(0, 32).Font.Bold = True
Cell.Offset(0, 32).Font.Color = vbYellow
End If
If Len(Cell.Offset(0, 33).Value) <> Cells(10, 33).Value Then
ErrorCount = ErrorCount + 1
Cell.Offset(0, 33).Interior.Color = vbRed
Cell.Offset(0, 33).Font.Bold = True
Cell.Offset(0, 33).Font.Color = vbYellow
End If
Next
'End Field #'s 18-20 and 32-34 Check
' ****************************************************************
'Start Field #'s 3 Check for Record 1000
'Check to make sure the length of Field [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=3]#3[/URL] for a 1000 record is 7 characters sa this is the ORD ID
For Each Cell In Rng
If Cell.Value = 1000 Then
If Len(Cell.Offset(0, 2).Value) <> Cells(5, 4).Value Then
ErrorCount = ErrorCount + 1
Cell.Offset(0, 2).Interior.Color = vbRed
Cell.Offset(0, 2).Font.Bold = True
Cell.Offset(0, 2).Font.Color = vbYellow
End If
End If
Next
'End Field #'s 3 Check for Record 1000
' ****************************************************************
'Start Field [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=3]#3[/URL] Check
'Check to make sure that the Values for 3000 records in field [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=3]#3[/URL] match their 2100 record field [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=3]#3[/URL] counterpart.
'Check Length of 2100 and 3000 cells are not greather than max field length
For Each Cell In Rng
If Cell.Value = 2100 Or Cell.Value = 3000 Then
Set Cell = Cell.Offset(0, 2)
If Len(Cell.Value) > Cells(10, 4).Value Then
ErrorCount = ErrorCount + 1
Cell.Interior.Color = vbRed
Cell.Font.Bold = True
Cell.Font.Color = vbYellow
End If
End If
Next
For Each Cell In Rng
Set UPI = Cell.Offset(0, 2)
If Cell.Value = 2100 Then
Set Cell2 = Cell.Offset(1, 0)
i = 1
Do While Cell2.Value = 3000
Set Cell3 = Cell2.Offset(0, 2)
If Cell3.Value = UPI.Value Then
ElseIf Cell3.Value <> UPI.Value Then
ErrorCount = ErrorCount + 1
Cell3.Interior.Color = vbRed
Cell3.Font.Bold = True
Cell3.Font.Color = vbYellow
End If
i = i + 1
Set Cell2 = Cell.Offset(i, 0)
Loop
'The section below must be at the end of my file so it totals up all the ErrorCount values and doesn't exit
'the sub without displaying the Message Box.
'Don't put any code below this
ElseIf Cell.Value = 5000 Then
Application.EnableEvents = True
Application.ScreenUpdating = True
'Displays a message box that the moving of the raw data has finished.
MsgBox "Total Number of Potential Errors Found = " & ErrorCount, vbInformation
Range("A23").Value = "Total # of Errors = " & ErrorCount
Exit Sub
End If
Next
'End Field [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=3]#3[/URL] Check
' ****************************************************************
Application.EnableEvents = True
Application.ScreenUpdating = True
End With
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub