RS Check Macros

rsChecks.bas

Option Explicit

Sub doRSChecks()
    Range("k2:k" & lastUsedRow).ClearContents
    checkForMissingNumbers
    checkForExtraNumbers
    checkRIDCategoryCode
    checkRIDDotsAndHyphens
    MsgBox "Done!"
End Sub

Sub checkRIDDotsAndHyphens()
    Dim cell As Range
    For Each cell In Range("a2:a" & lastUsedRow)
        Application.StatusBar = "Checking RID hypen and dot count | On row " & cell.Row
        If Not cell.Value Like "*CONTRA*" Then
            If Not Len(cell.Value) - Len(Replace(cell.Value, ".", "")) = 4 Then
                addToM cell.Row, "RID dot count is off"
            End If
            If Not Len(cell.Value) - Len(Replace(cell.Value, "-", "")) = 2 Then
                addToM cell.Row, "RID hyphen count is off"
            End If
        End If
    Next cell
    Application.StatusBar = False
End Sub

Sub checkRIDCategoryCode()
    Dim cell As Range
    For Each cell In Range("a2:a" & lastUsedRow)
        Application.StatusBar = "Checking RID category codes | On row " & cell.Row
        If Not cell.Value Like "*CONTRA*" Then
            If Not cell.Value Like "ASM*" _
            And Not cell.Value Like "BCM*" _
            And Not cell.Value Like "CCP*" _
            And Not cell.Value Like "CMP*" _
            And Not cell.Value Like "EIM*" _
            And Not cell.Value Like "IAM*" _
            And Not cell.Value Like "ITD*" _
            And Not cell.Value Like "OPS*" _
            And Not cell.Value Like "PEP*" _
            And Not cell.Value Like "PGM*" _
            And Not cell.Value Like "PIR*" _
            And Not cell.Value Like "SCS*" _
            And Not cell.Value Like "SLC*" _
            And Not cell.Value Like "TPR*" _
            And Not cell.Value Like "WFS*" Then
                addToM cell.Row, "RID doesn't start with a valid three-letter category code"
            End If
        End If
    Next cell
    Application.StatusBar = False
End Sub

Sub checkForExtraNumbers()
    Dim cell As Range
    For Each cell In Range("h2:h" & lastUsedRow)
        Dim target As Integer: target = CInt(Range("g" & cell.Row).Value)
        Dim i As Integer
        Dim RS As String: RS = cell.Value
        For i = target + 1 To 20
            Application.StatusBar = "Checking for EXTRA numbers within RS | On row " & cell.Row & "." & i
            If Not Range("a" & cell.Row) Like "*CONTRA*" Then
                 If RS Like "*" & i & ")*" _
                 Or RS Like "*" & i & "-*" Then
                    If Not RS Like "*." & i & ")*" _
                    And Not RS Like "*(" & i & ")*" Then
                        addToM cell.Row, "Unexpected number found within requirement statement (as compared to the requirement's stated element count): " & i
                    End If
                End If
            End If
        Next i
    Next cell
    Application.StatusBar = False
End Sub

Sub checkForMissingNumbers()
    Dim cell As Range
    For Each cell In Range("h2:h" & lastUsedRow)
        Dim target As Integer: target = CInt(Range("g" & cell.Row).Value)
        Dim i As Integer
        Dim RS As String: RS = cell.Value
        For i = 1 To target
            Application.StatusBar = "Checking for MISSING numbers  within RS | On row " & cell.Row & "." & i
            If Not Range("a" & cell.Row) Like "*CONTRA*" _
            And Not RS Like "*" & i & ")*" _
            And Not RS Like "*(356)*" _
            And Not RS Like "*" & i & ") days*" _
            And Not RS Like "*" & i & ".*" Then
                addToM cell.Row, "Cannot find expected number within requirement statement: " & i
            End If
        Next i
    Next cell
    Application.StatusBar = False
End Sub

'not a PQE input
Public Sub addToM(ByVal r As Integer, msg As String)
    Dim wb As String: wb = ActiveWorkbook.name
    Dim ws As String: ws = ActiveSheet.name
    If Workbooks(wb).Sheets(ws).Range("k1") = "" Then
        With Workbooks(wb).Sheets(ws).Range("k1")
            .FormulaLocal = "=CONCATENATE(COUNTif(K2:K9999,""*•*""),"" Possible Quality Issue(s)"")"
            .Font.Color = 255
            .Font.Bold = True
            .Font.Underline = True
            .EntireColumn.ColumnWidth = 70
        End With
    End If
    With Workbooks(wb).Sheets(ws).Range("k" & r)
        .WrapText = True
        If .Value = "" Then
            .Value = " • " & msg
        Else
            If InStr(1, Workbooks(wb).Sheets(ws).Range("k" & r).Value, msg) = 0 Then .Value = .Value & vbCrLf & " • " & msg
        End If
        
        .VerticalAlignment = xlVAlignTop
        .HorizontalAlignment = xlLeft
        .Font.Color = 255
                
    End With
    Workbooks(wb).Sheets(ws).Tab.Color = 255
    ReDim foundWord(0) As String
End Sub