Code not working as it should

[ipbr21054]

I have in place the code shown below

In TextBox2 i enter a vin number of 17 characters.
The 10th character represents the year,so if its a 3 then when the userform values are sent to my worksheet the cell in column I for this customer should show 2003

5 would show 2005
6 would show 2006
7 would show 2007
etc etc but i see some errors.

I see the following
Vin number Cell I
9 2010 Should be 2009
3 2004 should be 2003
6 2007 Should be 2006
3 2004 Should be 2003
8 2009 Should be 2008

There are also a few more like this BUT what i dont understand is that there are also vin numbers in use which also show 3,4,5 etc etc & in cell I is the correct year is shown ???
So how come some show,
9 2010 where others show 9 2009 ??????????????

Private Sub CommandButton1_Click()
      If OptionButton1.Value = True And OptionButton7.Value = False And OptionButton8.Value = False _
      And OptionButton9.Value = False And OptionButton10.Value = False And OptionButton11.Value = False Then
     
        MsgBox "You Must Select A Lead Type", vbCritical, "Lead Type Selection Error Message"
 Else
  If Len(Me.TextBox2.Value) = 17 Then
    Dim i As Long, x As Long
    Dim ControlsArr(1 To 8) As Variant, ns As Variant
    
    Application.ScreenUpdating = False
    For i = 1 To 8
      ControlsArr(i) = Controls(IIf(i > 2, "ComboBox", "TextBox") & i).Value
    Next i
    
    With ThisWorkbook.Worksheets("MC LIST")
      .Range("A8").EntireRow.Insert Shift:=xlDown
      .Range("A8:K8").Borders.Weight = xlThin
      .Cells(8, 1).Resize(, UBound(ControlsArr)).Value = ControlsArr
      .Cells(8, 2).Characters(Start:=10, Length:=1).Font.Color = -16776961
      
      If OptionButton1.Value Then .Cells(8, 10).Value = "YES"
      If OptionButton2.Value Then .Cells(8, 10).Value = "NO"
      If OptionButton2.Value Then .Cells(8, 11).Value = "N/A"
      If OptionButton7.Value Then .Cells(8, 11).Value = "BUNDLE"
      If OptionButton8.Value Then .Cells(8, 11).Value = "GREY"
      If OptionButton9.Value Then .Cells(8, 11).Value = "RED"
      If OptionButton10.Value Then .Cells(8, 11).Value = "BLACK"
      If OptionButton11.Value Then .Cells(8, 11).Value = "CLEAR"

      ns = Array("X", "Y", "1", "2", "3", "4", "5", "6", "7", "8", "9", "A", "B", "C", _
                 "D", "E", "F", "G", "H", "J", "K", "L", "M", "N", "P", "R", "S")
      For i = 0 To UBound(ns)
        If Mid(Range("B8").Value, 10, 1) = ns(i) Then
          Range("I8").Value = "" & 2000 + i
          Exit For
        End If
      Next

      Application.EnableEvents = False
      If .AutoFilterMode Then .AutoFilterMode = False
      x = .Cells(.Rows.Count, 1).End(xlUp).Row
      .Range("A7:K" & x).Sort Key1:=.Range("A8"), Order1:=xlAscending, Header:=xlGuess
      .Range("A:A").Find(TextBox1.Value, , xlValues, xlWhole).Select
      Application.Goto Selection, True
    End With
    ActiveWorkbook.Save
    MsgBox "Database Has Been Updated", vbInformation, "SUCCESSFUL MESSAGE"
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Unload McListForm
  Else
    MsgBox "VIN MUST BE 17 CHARACTERS" & vbCr & vbCr & "DATABASE WAS NOT UPDATED", vbCritical, "MC LIST TRANSFER"
    TextBox2.SetFocus
  End If
  End If
End Sub

 

[ipbr21054]

I think the way forward with this is something like below as opposed to whats currently in use so then i can keep track of it and knowing how to change / edit it etc myself.

Something like this BUT written correctly.
Target address is B8
Look at 10th character & place year in cell I8 when the following data

1 = 2001
2 = 2002
3 = 2003
4 = 2004
5 = 2005
ETC ETC
A = 2010
B = 2011
C = 2012
D = 2013

The current code in use is as follows

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
    Application.ScreenUpdating = False
    Application.EnableEvents = False
If Target.Address(0, 0) = "B8" Then
    If Len(Target) > 9 Then Target.Characters(Start:=10, Length:=1).Font.ColorIndex = 3
    Range("I8").Value = CStr(1998 + InStr(1, "XY123456789ABCDEFGHJKLMNPRSTUVW", Mid(Range("B8").Value, 10, 1), vbBinaryCompare))
End If
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

 

[mole999]

yes I did wonder how 2000 + i was going to pan out