An exception within the code

[ipbr21054]

Hi,
I have the code in use shown below.

When i enter a number into the field My Partner 99.9% of the time the character count will be 11 BUT an oddball has been recently introduced where it is a 13 characters count.
This is the ONLY 13 character number of its kind.
I DONT wish to alter the 11 to 13 in the code as this will open up a huge can of worms for people typing 12 characters etc & we then have a big clean up job,currently in place is a msgbox which works perfect.

So if possible what i require is the code to work the same at present BUT to allow the only 13 character of which is 08E56CAT88802 if so allow it but if not then show the msgbox PartNumberMessage.Show

Private Sub MyPartNumber_AfterUpdate()'Set the background to grey (in case its currently red due to an incorrect length part number having been entered)
Me.MyPartNumber.BackColor = RGB(180, 180, 180)
If MyPartNumber.Text = "" Then Exit Sub


'Add - characters if 11 part number is 11 characters long
If Len(Me.MyPartNumber.Value) = 11 Then Me.MyPartNumber.Value = Left(Me.MyPartNumber.Value, 5) & "-" & Mid(Me.MyPartNumber.Value, 6, 3) & "-" & Right(Me.MyPartNumber.Value, 3)


'Turn background red if part number is wrong length
If Len(Me.MyPartNumber.Value) <> 13 Then
Me.MyPartNumber.BackColor = RGB(255, 0, 0)
Me.MyPartNumber.SetFocus
Exit Sub
End If


'Check to see if value exists
If WorksheetFunction.CountIf(Sheet8.Range("Y:Y"), Me.MyPartNumber.Value) = 0 Then
PartNumberMessage.Show
Me.MyPartNumber.Value = ""
Me.MyPartNumber.SetFocus
Exit Sub
End If


'Lookup values based on first control
With Me
.HondaPartNumber = Application.WorksheetFunction.VLookup(Me.MyPartNumber, Sheet8.Range("HONDAORIGINALNUMBERS"), 2, 0)
.NumbersOnCase = Application.WorksheetFunction.VLookup(Me.MyPartNumber, Sheet8.Range("HONDAORIGINALNUMBERS"), 3, 0)
.NumbersOnPcb = Application.WorksheetFunction.VLookup(Me.MyPartNumber, Sheet8.Range("HONDAORIGINALNUMBERS"), 4, 0)
.Buttons = Application.WorksheetFunction.VLookup(Me.MyPartNumber, Sheet8.Range("HONDAORIGINALNUMBERS"), 5, 0)
.GoldSwitchesOnPcb = Application.WorksheetFunction.VLookup(Me.MyPartNumber, Sheet8.Range("HONDAORIGINALNUMBERS"), 6, 0)
.ItemType = Application.WorksheetFunction.VLookup(Me.MyPartNumber, Sheet8.Range("HONDAORIGINALNUMBERS"), 7, 0)
.Notes = Application.WorksheetFunction.VLookup(Me.MyPartNumber, Sheet8.Range("HONDAORIGINALNUMBERS"), 8, 0)
.Upgrade = Application.WorksheetFunction.VLookup(Me.MyPartNumber, Sheet8.Range("HONDAORIGINALNUMBERS"), 9, 0)
.MyPrice = Format(Application.WorksheetFunction.VLookup(Me.MyPartNumber, Sheet8.Range("HONDAORIGINALNUMBERS"), 10, 0), "£#,##0.00")
End With
End Sub

Have a nice day

 

[ipbr21054]

Hi,
Just wondering if you have had time to download the file.

many thanks