Select Case issue

[jostj]

Hi, I was working on an issue and this is the updated VBA i received from someone to use as a type of validation on a spreadsheet, but it doesnt seem to be working and i cant figure out for the life of me why it isnt.

what i originally had in mind is that when information is entered into any of the cells within cells f5:f100, there is VBA that checks to make sure the information that was entered into each cell had a character length of 8. if it was more or less, then a popup message would appear.

i cant get this to work.

any help or suggestions would be GREATLY appreciated.

thanks in advance!
-Jason






Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Cells.Count < 1 Then Exit Sub

Application.EnableEvents = False

'run code depending on what column the changed cell is in
Select Case Target.Column
Case 5 'column E
'code for col E goes here
Case 6 'column F
'if changed cell is within the range F5:F100
If Not Intersect(Target, [F5:F100]) Is Nothing Then
'if cell is NOT empty and length is <>8
If Target <> "" And Len(Target) <> 8 Then
'display msg
MsgBox "There is an error in cell " & Target.Address(0, 0) & "."
End If
End If
Case 7 'column G
'code for col G goes here
End Select

Application.EnableEvents = True

End Sub

 

[lenze]

Do you have code for columns "E" & "G"? If not, you don't need Select Case

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Cells.Count >1 Then Exit Sub

Application.EnableEvents = False

If  Intersect(Target, [F5:F100]) Is Nothing Then Exit Sub
     If Target <> "" And Len(Target) <> 8 Then
         MsgBox "There is an error in cell " & Target.Address & "."
     End If

Application.EnableEvents = True
End Sub

lenze

 

[erik.van.geit]

Hi,

this code will only check the input if there is a single cell change.
You could even undo if there are more cells changed at once.

Private Sub Worksheet_Change(ByVal Target As Range)
 
If Target.Cells.Count > 1 Then Exit Sub
If Intersect(Target, [F5:F100]) Is Nothing Then Exit Sub
 
    If Target <> "" And Len(Target) <> 8 Then
        With Application
        .EnableEvents = False
        .Undo
        .EnableEvents = True
        End With
    MsgBox "The length of your input must be 8 characters ", vbCritical, "ERROR"
    End If
 
End Sub

kind regards,
Erik

EDIT: Wrong entry is cleared

 

[lenze]

Hey Erik: How's it going with "The One"??
Good point about the Undo
lenze

 

[ColinKJ]

Hi Jason,

You've now got a lot of options.

This one works for Column F Rows 1 to 100

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 6 And Target.Row < 101 And Cells(Target.Row, Target.Column) <> "" Then
    If Len(Cells(Target.Row, Target.Column)) <> 8 Then
        MsgBox ("Entry Must Be 8 Characters Long")
        Cells(Target.Row, Target.Column) = ""
    End If
End If
End Sub

Good Luck

ColinKJ

 

[Kenneth Hobson]

Your problem was the <1 as lenze noted. Of course you could modify it to select each cell if they are changed.

Another option if you don't want to undo. It uses SendKeys so UAC has to be off if you are using Vista.

Private Sub Worksheet_Change(ByVal Target As Range)
  
  If Target.Cells.Count > 1 Then Exit Sub
  
  Application.EnableEvents = False
  
  'run code depending on what column the changed cell is in
  Select Case Target.Column
    Case 5 'column E
    'code for col E goes here
    Case 6 'column F
    'if changed cell is within the range F5:F100
    If Not Intersect(Target, [F5:F100]) Is Nothing Then
      'if cell is NOT empty and length is <>8
      If Target <> "" And Len(Target) <> 8 Then
        'display msg
        MsgBox "There is an error in cell " & Target.Address(0, 0) & "."
        Target.Select
        SendKeys "{F2}"
      End If
    End If
    Case 7 'column G
    'code for col G goes here
  End Select
  
  Application.EnableEvents = True

End Sub

 

[jostj]

Awesome everyone!
thanks again for the help. i wish i could repay you.

 

[erik.van.geit]

Hey Erik: How's it going with "The One"??
Good point about the Undo
lenze

Normally I would answer this by PM
Everything, very well Nathalie is sitting next to me.
Thanks a lot!

 

[jostj]

Sorry guys I have one more issue to resolve on this.

one problem that comes up with the coding is that when someone selects more than one cell in the column (f) and tries to delete the information in those cells (even if empty) i get a "type mismatch" error.
is there a simple solution around this?


thanks again!!!!!

 

[ColinKJ]

jostj,

Did you use the line

If Target.Cells.Count > 1 Then Exit Sub

At the begining of the code, this should avoid the error.

ColinKJ