Validates CAS Registry Numbers for length and checksum. Intended to be used in Excel for data validation.

ValidateCASRN.vb

    ' This is a quick VBA function to validate CAS Registry Numbers for length and checksum.
    ' It does not check the location of the dashes, and will fail if non-digits are included.
    ' Spaces are ignored. Blanks can either be allowed or not, depending on your use case.
    ' https://en.wikipedia.org/wiki/CAS_Registry_Number
    ' Usage: Debug.Print ValidateCAS("7732-18-5")
    Public Function ValidateCASRN(ByVal CAS As String, Optional ByVal allowBlank As Boolean = False) As Boolean
        Application.Volatile False
        
        Dim numDigits As Integer
        Dim sum As Integer
        Dim i As Integer
        Dim digit As Integer
        Dim checksum As Integer
        
        ' Remove dashes and spaces
        CAS = Replace$(Replace$(CAS, "-", ""), " ", "")
        If CAS = "" Then
            ValidateCASRN = allowBlank
            Exit Function
        End If
        numDigits = Len(CAS)

        If (numDigits < 5) Or (numDigits > 10) Then
            ' CAS numbers include 2-7 digits in the first group, 2 in the next, 1 final checksum digit
            ValidateCASRN = False
            Exit Function
        End If

        For i = numDigits - 1 To 1 Step -1
            digit = CInt(Mid$(CAS, i, 1))
            sum = sum + (numDigits - i) * digit
        Next
        
        checksum = CInt(Right$(CAS, 1))
        ValidateCASRN = (checksum = (sum Mod 10))

    End Function