Cell must be 11 or 17 characters

[ipbr21054]

Hi & Good Morning,

I have been working with a code for a while where the cell in question must have 17 characters otherwise the code would do its job.
Example SHHFN13408U004767

I have recently had the need to now allow 11 characters.
Example RG3-1009939

So the code needs to be working for 11 & 17 characters.

The current code in use is supplied below & asking if there is an easy solution to allow this.

Private Sub Worksheet_Change(ByVal Target As Range)Dim Frng As Range
Set Frng = Range("F21", Range("F" & Rows.Count).End(xlUp))
If Target.Address(0, 0) = "A2" Then
    With HondaSoldItems
        .Caption = "HONDA SOLD ITEMS TABLE"
        .txtQuantitySold.Text = Application.CountIf(Frng, Target.Value)
        .txtSoldItems.Text = Target.Value
        .CommandButton1.SetFocus
        .Show
        End With
End If
With ThisWorkbook.Sheets("HONDA SHEET")
If Not Intersect(Target, .Range("A13")) Is Nothing And .Range("A13") <> "" Then
If Len(.Range("A13").Value) <> 17 Then
                .Range("A13").Interior.ColorIndex = 3
                 MsgBox ("Honda Chassis Number Must Be 17 Characters, Please Try Again"), 16
                .Range("A13").ClearContents
                .Range("A13").Interior.ColorIndex = 2
                .Range("A13").Activate
Else
                Application.EnableEvents = False
                .Rows(21).Insert Shift:=xlDown
                .Range("A21:G21").Borders.Weight = xlThin
                .Range("G21").Value = Date
                .Range("A21").Value = UCase(.Range("A13").Value)
                .Range("B21").Select
                .Range("A13").ClearContents
                .Range("A21").Characters(Start:=10, Length:=1).Font.ColorIndex = 3
                Application.EnableEvents = True
End If
End If


End With


Target.Interior.ColorIndex = 6
If Not Intersect(Target, Range("F21")) Is Nothing Then
If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub
If Target.Value = "ACCORD ID 48" Then Range("D1").Value = Range("D1").Value + 1
If Target.Value = "ACCORD ID 8E" Then Range("D2").Value = Range("D2").Value + 1
If Target.Value = "BLACK NRK ID 46" Then Range("D3").Value = Range("D3").Value + 1
If Target.Value = "BLACK NRK ID 48" Then Range("D4").Value = Range("D4").Value + 1
If Target.Value = "BLACK NRK ID 8E" Then Range("D5").Value = Range("D5").Value + 1
If Target.Value = "CIVIC CE0523" Then Range("D6").Value = Range("D6").Value + 1
If Target.Value = "CRV HLIK-1T" Then Range("D7").Value = Range("D7").Value + 1
If Target.Value = "CRV ID 48" Then Range("D8").Value = Range("D8").Value + 1
If Target.Value = "FLIP HLIK-1T 2B" Then Range("D9").Value = Range("D9").Value + 1
If Target.Value = "FLIP HLIK-1T 3B" Then Range("D10").Value = Range("D10").Value + 1
If Target.Value = "FRV ID 48" Then Range("D11").Value = Range("D11").Value + 1
If Target.Value = "FRV ID 8E" Then Range("D12").Value = Range("D12").Value + 1
If Target.Value = "G8D-345H-A" Then Range("D13").Value = Range("D13").Value + 1
If Target.Value = "G8D-348H-A" Then Range("D14").Value = Range("D14").Value + 1
If Target.Value = "G8D-350H-A" Then Range("D15").Value = Range("D15").Value + 1
If Target.Value = "G8D-453H-A" Then Range("D16").Value = Range("D16").Value + 1
If Target.Value = "G8D-456H-A" Then Range("D17").Value = Range("D17").Value + 1
If Target.Value = "HONDA 001" Then Range("F1").Value = Range("F1").Value + 1
If Target.Value = "HONDA 022" Then Range("F2").Value = Range("F2").Value + 1
If Target.Value = "HONDA 023" Then Range("F3").Value = Range("F3").Value + 1
If Target.Value = "HONDA 024" Then Range("F4").Value = Range("F4").Value + 1
If Target.Value = "HONDA 036" Then Range("F5").Value = Range("F5").Value + 1
If Target.Value = "HONDA 042" Then Range("F6").Value = Range("F6").Value + 1
If Target.Value = "HON 58 ID 13" Then Range("F7").Value = Range("F7").Value + 1
If Target.Value = "HON 58 ID 48" Then Range("F8").Value = Range("F8").Value + 1
If Target.Value = "JAZZ HLIK-1T" Then Range("F9").Value = Range("F9").Value + 1
If Target.Value = "JAZZ ID 48" Then Range("F10").Value = Range("F10").Value + 1
If Target.Value = "JAZZ ID 8E" Then Range("F11").Value = Range("F11").Value + 1
If Target.Value = "KEY DIY NBXTT ID 47" Then Range("F12").Value = Range("F12").Value + 1
If Target.Value = "LEGEND ID 8E" Then Range("F13").Value = Range("F13").Value + 1
If Target.Value = "SILVER NRK ID 48" Then Range("F14").Value = Range("F14").Value + 1
If Target.Value = "SILVER NRK ID 8E" Then Range("F15").Value = Range("F15").Value + 1
If Target.Value = "72147-S2H-G01" Then Range("F16").Value = Range("F16").Value + 1
If Target.Value = "Z EMPTY 2" Then Range("F17").Value = Range("F17").Value + 1
End If
    If Target.Address = "$F$21" Then
        Call sheettolist




End If
Application.EnableEvents = True
End Sub

 

[jmacleary]

Hi there. You just need to change the IF statement as follows:

If Len(.Range("A13").Value) <> 17[COLOR=#ff0000] AND Len(.Range("A13").Value) <> 11[/COLOR] Then
                .Range("A13").Interior.ColorIndex = 3
                 MsgBox ("Honda Chassis Number Must Be [COLOR=#ff0000]11 or [/COLOR]17 Characters, Please Try Again"), 16
                .Range("A13").ClearContents
                .Range("A13").Interior.ColorIndex = 2
                .Range("A13").Activate
Else
                Application.EnableEvents = False
                .Rows(21).Insert Shift:=xlDown
                .Range("A21:G21").Borders.Weight = xlThin
                .Range("G21").Value = Date
                .Range("A21").Value = UCase(.Range("A13").Value)
                .Range("B21").Select
                .Range("A13").ClearContents
                .Range("A21").Characters(Start:=10, Length:=1).Font.ColorIndex = 3
                Application.EnableEvents = True
End If

I have shown the changes in red.

 

[ipbr21054]

Many thanks & have a nice day.

Works great.