National Insurance number validation on blocks of data

[bruty]

I have a spreadsheet where data is pasted on from spreadsheet supplied by various external companies. One of the main problems we're having when validating the data is an incorrect NI Number and I'm hoping to find a way of getting this automated.

What I would like to do is, when a block of text is pasted into our template, a block of code to look through the selection and check column S for a valid format NI no (eg AB123456C). I have some code (below) that works when changing an individual cell, but nothing that works when pasting in blocks of text.

Can anyone offer some advice?

Private Sub Worksheet_Change(ByVal Target As Range)

stringvalue = Target.Value

statuschange = 0

Application.EnableEvents = False

'Check for text only cells
If Target.Column = 19 Then

        stringvalue = UCase(stringvalue)
        chars = Len(stringvalue)
        'newvalue = ""
        For Counter = 1 To chars
        
            Select Case Counter
            
            Case 1, 2, 9
                If Asc(Mid(stringvalue, Counter, 1)) >= 65 And Asc(Mid(stringvalue, Counter, 1)) <= 90 Then
                    
                Else
                    statuschange = 1
                End If
            Case 3 To 8
                If Asc(Mid(stringvalue, Counter, 1)) >= 48 And Asc(Mid(stringvalue, Counter, 1)) <= 57 Then
                
                Else
                    statuschange = 1
                End If
            End Select
        
        Next Counter

End If

Application.EnableEvents = True

'Error messages
If statuschange = 1 Then
mymessage = MsgBox("The National Insurance number you have entered is invalid. You have an invalid format for an NI number." & vbNewLine & "Please ensure you enter a National Insurance number using the format AA123456A", vbOKOnly, "INVALID ENTRIES - NATIONAL INSURANCE NUMBER")
ElseIf statuschange = 2 Then
mymessage = MsgBox("The National Insurance number you have entered is invalid. You have the wrong number of numerical characters." & vbNewLine & "Please ensure you enter a National Insurance number using the format AA123456A", vbOKOnly, "INVALID ENTRIES - NATIONAL INSURANCE NUMBER")
End If

Target.Select

End Sub

 

[al_b_cnu]

Hi,

How about:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim bError As Boolean
Dim iLen As Integer, Counter As Integer
Dim rCur As Range
Dim stringValue As String, sMessage As String, sChar As String

Application.EnableEvents = False

sMessage = ""
For Each rCur In Target
    If rCur.Column = 19 Then
            stringValue = UCase$(CStr(rCur.Value))
            iLen = Len(stringValue)
            If iLen <> 0 Then
                bError = iLen <> 9
                If bError = False Then
                    For Counter = 1 To Len(stringValue)
                        sChar = Mid$(stringValue, Counter, 1)
                        Select Case Counter
                        Case 1, 2, 9
                            If LCase$(sChar) = UCase$(sChar) Then
                                bError = True
                                Exit For
                            End If
                                
                        Case 3 To 8
                            bError = IsNumeric(sChar) = False
                            If bError Then Exit For
                        End Select
                    
                    Next Counter
                End If
                If bError Then
                    sMessage = sMessage & stringValue & vbCrLf
                End If
            End If
    End If
Next rCur

Application.EnableEvents = True

If Len(sMessage) <> 0 Then
    MsgBox prompt:="The following NI Numbers are  invalid:" & vbCrLf & sMessage, _
            Buttons:=vbOKOnly + vbCritical, _
            Title:="INVALID ENTRIES - NATIONAL INSURANCE NUMBER"
End If

End Sub

(Edited to move Application.EnableEvents=True)

 

[bruty]

Works great cheers. Is there any way of flagging the line number the error occurs on?

Sorry to be a pain

 

[bruty]

Never mind, changed it to read this and it works:

sMessage = sMessage & stringValue & " - Line " & rCur.Row & vbCrLf

Many thanks again for the quick reply

 

[bruty]

Aarrrgggghhh!!

It was all working well, and I modified it slightly and somehow I've managed to knacker it up.

In the code below, when I compile it it throws an error on the (attempted) bolded Next line - and I can't see why. It says Next without For, but from what I can see it all looks fine.

What am I missing??

Private Sub Worksheet_Change(ByVal Target As Range)
Dim bError As Boolean
Dim iLen As Integer, Counter As Integer
Dim iYear As Integer
Dim rCur As Range
Dim stringValue As String, sMessage As String, sChar As String
Dim stringValue2 As String, tMessage As String

Application.EnableEvents = False

sMessage = ""
tMessage = ""
For Each rCur In Target
    If rCur.Column = 15 Then
            stringValue2 = CStr(rCur.Value)
            If stringValue2 <> "" Then
            iYear = Year(stringValue2)
            If Year(Date) - iYear <= 15 Then
                    tMessage = tMessage & stringValue2 & " - Line " & rCur.Row & vbCrLf
            End If
    ElseIf rCur.Column = 19 Then
            stringValue = UCase$(CStr(rCur.Value))
            iLen = Len(stringValue)
            If iLen <> 0 Then
                bError = iLen <> 9
                If bError = False Then
                    For Counter = 1 To Len(stringValue)
                        sChar = Mid$(stringValue, Counter, 1)
                        Select Case Counter
                        Case 1, 2, 9
                            If LCase$(sChar) = UCase$(sChar) Then
                                bError = True
                                Exit For
                            End If
                                
                        Case 3 To 8
                            bError = IsNumeric(sChar) = False
                            If bError Then Exit For
                        End Select
                    Next Counter
                End If
                If bError Then
                    sMessage = sMessage & stringValue & " - Line " & rCur.Row & vbCrLf
                End If
            End If
    End If
Next rCur <<<<< error here

Application.EnableEvents = True

If Len(tMessage) <> 0 Then
    MsgBox prompt:="The following dates of birth are invalid:" & vbCrLf & tMessage, _
            Buttons:=vbOKOnly + vbCritical, _
            Title:="INVALID ENTRIES - DATES OF BIRTH"
End If
If Len(sMessage) <> 0 Then
    MsgBox prompt:="The following NI Numbers are invalid:" & vbCrLf & sMessage, _
            Buttons:=vbOKOnly + vbCritical, _
            Title:="INVALID ENTRIES - NATIONAL INSURANCE NUMBER"
End If

End Sub

 

[Norie]

You're missing at least one End If.

This will compile, but I'm not sure if it'll actually do what you want since I'm having trouble following the logic of the code.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim bError As Boolean
Dim iLen As Integer, Counter As Integer
Dim iYear As Integer
Dim rCur As Range
Dim stringValue As String, sMessage As String, sChar As String
Dim stringValue2 As String, tMessage As String

Application.EnableEvents = False

sMessage = ""
tMessage = ""
For Each rCur In Target
    If rCur.Column = 15 Then
            stringValue2 = CStr(rCur.Value)
            If stringValue2 <> "" Then
                iYear = Year(stringValue2)
            End If
                If Year(Date) - iYear <= 15 Then
                        tMessage = tMessage & stringValue2 & " - Line " & rCur.Row & vbCrLf
                End If
    ElseIf rCur.Column = 19 Then
            stringValue = UCase$(CStr(rCur.Value))
            iLen = Len(stringValue)
            If iLen <> 0 Then
                bError = iLen <> 9
                If bError = False Then
                    For Counter = 1 To Len(stringValue)
                        sChar = Mid$(stringValue, Counter, 1)
                        Select Case Counter
                        Case 1, 2, 9
                            If LCase$(sChar) = UCase$(sChar) Then
                                bError = True
                                Exit For
                            End If
                                
                        Case 3 To 8
                            bError = IsNumeric(sChar) = False
                            If bError Then Exit For
                        End Select
                    Next Counter
                End If
                If bError Then
                    sMessage = sMessage & stringValue & " - Line " & rCur.Row & vbCrLf
                End If
            End If
    End If
Next rCur

Application.EnableEvents = True

If Len(tMessage) <> 0 Then
    MsgBox prompt:="The following dates of birth are invalid:" & vbCrLf & tMessage, _
            Buttons:=vbOKOnly + vbCritical, _
            Title:="INVALID ENTRIES - DATES OF BIRTH"
End If
If Len(sMessage) <> 0 Then
    MsgBox prompt:="The following NI Numbers are invalid:" & vbCrLf & sMessage, _
            Buttons:=vbOKOnly + vbCritical, _
            Title:="INVALID ENTRIES - NATIONAL INSURANCE NUMBER"
End If

End Sub

PS I'm pretty sure you could check the NI nos without looping through each character in them.

 

[bruty]

Cheers - managed to stick an EndIf in earlier and it seems to work now.

As for the logic behind the code, it's based on the example pasted above (thanks to al_b_cnu) and modified by me in my own nonsensical way - I'm not the best of programmers and just cobble bits together until it works or I give up.

That's the same reason for the NI check - it may not be the best way of doing it, but it works so I was happy. If you have any better and more efficient ways I'm all ears

 

[John_w]

You might like to look at NI Guidance for Software Developers for 2003+ linked from http://www.hmrc.gov.uk/ebu/ebu_paye_ts.htm for the complete NI number specification, including the valid prefixes.

The Supplements also on that page contain the latest forthcoming prefixes.

 

[barry houdini]

Also I believe that the last letter must be either A, B, C or D (or a space according to this)

 

[bruty]

Cheers all.