Code for character allowance in cell

[ipbr21054]

Morning,

I am looking for a code which will show a msgbox to advise me the character count in the active cell is anything but 17

Some info for you.
Worksheet is called MC LIST
The code will only need to work for column B
The range would be B6 & down the page

Example,

So i type in cell B9 15 characters & when i leave the cell a msg box pops up saying only 15 characters typed etc.

Same scenario if i was to type 19 characters etc.

If 17 characters are typed then when i leave the active cell no msg box is to be shown.
@DanteAmor

Many thanks

 

[Peter_SSs]

Try this Worksheet_Change event code. To implement ..
1. Right click the 'MC LIST' sheet name tab and choose "View Code".
2. Copy and Paste the code below into the main right hand pane that opens at step 1.
3. Close the Visual Basic window & test.

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim Changed As Range, cell As Range
  Dim sMsg As String
  
  Set Changed = Intersect(Target, Range("B6:B" & Rows.Count))
  If Not Changed Is Nothing Then
    For Each cell In Changed
      If Len(cell.Text) <> 17 Then sMsg = sMsg & vbLf & cell.Address(0, 0) & vbTab & Len(cell.Text)
    Next cell
    If Len(sMsg) > 0 Then MsgBox "Cell" & vbTab & "Characters" & sMsg
  End If
End Sub

 

[DanteAmor]

I can also recommend using Data Validation:

Limit Characters Length In A Cell

1. Select the range that you will limit date entries with specify character length i.e. B6:B1000.


2. Click the Data validation in the Data Tools group under Data tab.


3. In the Data Validation dialog box, select the Text Length item from the Allow: drop down box.


4. In the Data: drop down box, select equal to.


5. In Length: Entry 17.


6. Click OK.

----------------------------------
But, if you want the code.

In addition to the message, what you need to do, do not allow text entry.
If so, then it could be like this:

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim c As Range
  On Error GoTo AllowEvents
  If Target.Count > 1000 Then Exit Sub
  If Not Intersect(Target, Range("B:B")) Is Nothing Then
    For Each c In Target
      If c.Row > 5 And c.Column = 2 Then
        If Len(c.Value) <> 17 Then
          Application.EnableEvents = False
          MsgBox "Only 17 characters are allowed"
          c.Value = ""
          c.Select
        End If
      End If
    Next
  End If
AllowEvents:
  Application.EnableEvents = True
End Sub

----------------------------------
SHEET EVENT
Right click the tab of the sheet (MC LIST) you want this to work , select view code and paste the code into the window that opens up.

 

[ipbr21054]

@DanteAmor
I have used your code as shown below.

Many thanks

[/B]Private Sub Worksheet_Change(ByVal Target As Range)  Dim c As Range
  On Error GoTo AllowEvents
  If Target.Count > 1000 Then Exit Sub
  If Not Intersect(Target, Range("B:B")) Is Nothing Then
    For Each c In Target
      If c.Row > 5 And c.Column = 2 Then
        If Len(c.Value) <> 17 Then
          Application.EnableEvents = False
          MsgBox "VIN MUST BE 17 CHARACTERS", vbCritical, "VIN CHARACTER COUNT MESSAGE"
          c.Value = ""
          c.Select
        End If
      End If
    Next
  End If
AllowEvents:
  Application.EnableEvents = True

End Sub[B]

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.

 

[Peter_SSs]

@ DanteAmor
I have used your code as shown below.

Just wondering why you don't use Excel's built-in Data Validation as suggested by Dante? With that you can include your message heading and text via the 'Error Alert' tab in the Data Validation dialog.

Also, I assume that it is fine for the user to delete a VIN number? If so, your code still gives the error message pop-up (particularly painful if you have selected, say, 20 cells in the column and pressed 'Delete') whereas the Data Validation would not.

However, if you want to persist with the vba (& there may be good reason to do that) and deleting a VIN number is acceptable, then I would suggest one change to the code:

If Len(c.Value) <> 17 And Len(c.Value) > 0 Then

 

[ipbr21054]

Thatsnk,
I had already encountered the error message when deleting & had also added that code last night.

Have a nice day

 

[Peter_SSs]

Thatsnk,
I had already encountered the error message when deleting & had also added that code last night.

Have a nice day

OK, good.

 

[DanteAmor]

If so, your code still gives the error message pop-up (particularly painful if you have selected, say, 20 cells in the column and pressed 'Delete') whereas the Data Validation would not.

If Len(c.Value) <> 17 And Len(c.Value) > 0 Then

Hi Peter, thanks for the observation. We usually tried some scenarios trying to cover all possibilities, but this time I never tried to delete a cell.