Validate a UK Postcode

Public Function IsUKPostCode(strInput As String)

'Uses a regular expression to validate the format of a postcode.
'May require WindowsScripting 5.6 - downloadable from microsoft.com

Dim RgExp As Variant

'Create the regular expression object
Set RgExp = CreateObject("VBScript.RegExp")

'Clear the function value
IsUKPostCode = ""

'Check we have value to test
If strInput = "" Then

    IsUKPostCode = "Not Supplied"
    
    Exit Function

End If
    
    'This is the ridiculously complex expression that validates the postcode
    RgExp.Pattern = "(?:(?:A[BL]|B[ABDHLNRST]?|" _
                & "C[ABFHMORTVW]|D[ADEGHLNTY]|E[CHNX]?|F[KY]|G[LUY]?|" _
                & "H[ADGPRSUX]|I[GMPV]|JE|K[ATWY]|L[ADELNSU]?|M[EKL]?|" _
                & "N[EGNPRW]?|O[LX]|P[AEHLOR]|R[GHM]|S[AEGKLMNOPRSTWY]?|" _
                & "T[ADFNQRSW]|UB|W[ACDFNRSV]?|YO|ZE)" _
                & "\d(?:\d|[A-Z])? \d[A-Z]{2})"
    
    'Does the fed in string match the pattern?
    If RgExp.test(strInput) = True Then
    
        IsUKPostCode = "Valid"
        
    Else
    
        '------------------------------
        'Try to make a correct postcode
        '------------------------------
         
        'Despace & uppercase
        strInput = UCase(Replace(strInput, " ", ""))
         
        'Clean out any redundant characters - whilst most of these don't make sense
        'I've seen them all in postcodes before!
        strInput = Replace(strInput, "_", "")
        strInput = Replace(strInput, ",", "")
        strInput = Replace(strInput, "+", "")
        strInput = Replace(strInput, "-", "")
        strInput = Replace(strInput, ":", "")
        strInput = Replace(strInput, "=", "")
        strInput = Replace(strInput, "/", "")
        strInput = Replace(strInput, "*", "")
        strInput = Replace(strInput, "?", "")
         
        '---------------------------------------------------------------------------
        'Check the string length again to make sure we've not got a "???" type entry
        '---------------------------------------------------------------------------
        
        If Len(strInput) = 0 Then
        
            IsUKPostCode = "Not Supplied"
            Exit Function
            
        ElseIf IsNumeric(strInput) Then
        
            IsUKPostCode = "All Numbers"
            Exit Function
            
        ElseIf Len(strInput) < 6 Then
        
            IsUKPostCode = "Too Short"
            Exit Function
                    
        End If
         
        'Check for and correct substituted O (alpha) for 0 (numeric) at position len - 2
        If Mid(strInput, Len(strInput) - 2, 1) = "O" Then strInput = _
        Left(strInput, Len(strInput) - 3) & "0" & Right(strInput, 2)
        
        'Check for and correct substituted 0 (numeric) for O (alpha) at position 1 or 2
        If Mid(strInput, 2, 1) = "0" Then strInput = _
        Left(strInput, 1) & "O" & Right(strInput, Len(strInput) - 2)
        
        If Left(strInput, 1) = "0" Then strInput = _
        "O" & Right(strInput, Len(strInput) - 1)
        
        'Check for and correct substituted lowercase l for 1 at position len - 2
        If Mid(strInput, Len(strInput) - 2, 1) = "l" Then strInput = _
        Left(strInput, Len(strInput) - 3) & "1" & Right(strInput, 2)
        
        'Check for and correct substituted lowercase l for 1 at position 3
        If Mid(strInput, 3, 1) = "l" Then strInput = _
        Left(strInput, 2) & "1" & Right(strInput, Len(strInput) - 3)
        
        'Check for and correct substituted S for 5 at position len - 3
        If Mid(strInput, Len(strInput) - 3, 1) = "S" Then strInput = _
        Left(strInput, Len(strInput) - 3) & "5" & Right(strInput, 2)
         
        'Two possible lengths for a valid UK postcode
        Select Case Len(strInput)
                 
        Case 6
             
            If RgExp.test(Left(strInput, 3) & " " & Right(strInput, 3)) = True Then
                 
                 'Format should be ?## #?? or ??# #??
                 IsUKPostCode = Left(strInput, 3) & " " & Right(strInput, 3)
                 
            Else
            
            IsUKPostCode = "Invalid"
                 
            End If
         
        Case 7
        
             If RgExp.test(Left(strInput, 4) & " " & Right(strInput, 3)) = True Then
             
                 'Format is ??## #?? or ?#?# #??
                 IsUKPostCode = Left(strInput, 4) & " " & Right(strInput, 3)
                 
            Else
            
                IsUKPostCode = "Invalid"
         
            End If
            
        Case Else
        
            IsUKPostCode = "Invalid"
             
        End Select
        
    End If
    


End Function