data validation

S

sjoerd.bosch

New Member
Joined
Feb 9, 2012
Messages
49
I need a data validation restriction for a cell
problem is that the cell in which I need the restriction contains a formula and I guess that is the reason why my data validation entry does not work.
For example: cell d4 / cell d5 = result in cell d6 The result in cell d6 should be not less than 12.0000 (decimals must be allowed)
A VBA code is also possible, but I thought this would be something simple in data validation
 
Sort by date Sort by votes
Thanks @Akuini , I also realised that the F24 value is a result of a division of F20/F22 so I had to rewrite the entire code. @sjoerd.bosch , please try the amended code below:

VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.CountLarge = 1 Then
        On Error GoTo Escape
        Application.EnableEvents = False
        Target = Trim(VBA.UCase(Target.Value2))
        Target.Replace ",", "."
        
        If Target.Address = "$F$15" Then
            If Not Target Like "##-##.# [N]" And Not Target Like "##-##.# " Then
                MsgBox "Latitude must be entered in the format 00-00.0 N (or S)"
                Target = "00-00.0 N"
                GoTo Continue
            End If
            If Left(Target, 2) > 90 Then
                MsgBox "Maximum allowable values are: 90-99.9"
                Target = "00-00.0 N"
                GoTo Continue
            End If
        End If
        
        If Target.Address = "$F$16" Then
            If Not Target Like "###-##.# [E]" And Not Target Like "###-##.# [W]" Then
                MsgBox "Longitude must be entered in the format 000-00.0 E (or W)"
                Target = "000-00.0 E"
                GoTo Continue
            End If
            If Left(Target, 3) > 180 Then
                MsgBox "Maximum allowable values are: 180-99.9"
                Target = "000-00.0 E"
                GoTo Continue
            End If
        End If
        
        If Not Intersect(Range("F20,F22,F24"), Target) Is Nothing Then
            If Range("$F$24") < 12 Then
                MsgBox "Formula results in F24 less than 12 - please re-enter"
                Target.Select
            End If
        End If
    End If
    
Continue:
    Application.EnableEvents = True
    Exit Sub
Escape:
    MsgBox "Error " & Err.Number & ": " & Err.Description
    Resume Continue
End Sub
 
Upvote 0

Excel Facts

Can you AutoAverage in Excel?
There is a drop-down next to the AutoSum symbol. Open the drop-down to choose AVERAGE, COUNT, MAX, or MIN
yes. you are correct. Now it is working properly.
Many thanks again !!
Akuini said:
@kevin9999
I think your code in post #23 misplaces an "End If":
Rich (BB code): 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.CountLarge = 1 And Not Intersect(Range("F15:F16, F20,F22,F24"), Target) Is Nothing Then
        On Error GoTo Escape
        Application.EnableEvents = False
        Target = Trim(VBA.UCase(Target.Value2))
        Target.Replace ",", "."
      
        If Target.Address = "$F$15" Then
            If Not Target Like "##-##.# [N]" And Not Target Like "##-##.# " Then
                MsgBox "Latitude must be entered in the format 00-00.0 N (or S)"
                Target = "00-00.0 N"
                GoTo Continue
            End If
            If Left(Target, 2) > 90 Then
                MsgBox "Maximum allowable values are: 90-99.9"
                Target = "00-00.0 N"
                GoTo Continue
            End If
        End If
      
        If Target.Address = "$F$16" Then
            If Not Target Like "###-##.# [E]" And Not Target Like "###-##.# [W]" Then
                MsgBox "Longitude must be entered in the format 000-00.0 E (or W)"
                Target = "000-00.0 E"
                GoTo Continue
            End If
            If Left(Target, 3) > 180 Then
                MsgBox "Maximum allowable values are: 180-99.9"
                Target = "000-00.0 E"
                GoTo Continue
            End If
            'End If  <-- misplaced
        End If
      
        If Range("F24") < 12 Then
            MsgBox "Formula results in D5 less than 12 - please re-enter"
            Target.Select
        End If  '<-- should be here

    End If
Continue:
    Application.EnableEvents = True
    Exit Sub
Escape:
    MsgBox "Error " & Err.Number & ": " & Err.Description
    Resume Continue
End Sub
Click to expand...
 
Upvote 0
Hi Kevin,

I am getting the error box now also when typing in cells F15 and F16
And also - the code below line
If Not Target Like "##-##.# [N]" And Not Target Like "##-##.# " Then
should be
If Not Target Like "##-##.# [N]" And Not Target Like "##-##.# [S]" Then
else I am getting an error when typing in the S for South

kevin9999 said:
Thanks @Akuini , I also realised that the F24 value is a result of a division of F20/F22 so I had to rewrite the entire code. @sjoerd.bosch , please try the amended code below:

VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.CountLarge = 1 Then
        On Error GoTo Escape
        Application.EnableEvents = False
        Target = Trim(VBA.UCase(Target.Value2))
        Target.Replace ",", "."
       
        If Target.Address = "$F$15" Then
            If Not Target Like "##-##.# [N]" And Not Target Like "##-##.# " Then
                MsgBox "Latitude must be entered in the format 00-00.0 N (or S)"
                Target = "00-00.0 N"
                GoTo Continue
            End If
            If Left(Target, 2) > 90 Then
                MsgBox "Maximum allowable values are: 90-99.9"
                Target = "00-00.0 N"
                GoTo Continue
            End If
        End If
       
        If Target.Address = "$F$16" Then
            If Not Target Like "###-##.# [E]" And Not Target Like "###-##.# [W]" Then
                MsgBox "Longitude must be entered in the format 000-00.0 E (or W)"
                Target = "000-00.0 E"
                GoTo Continue
            End If
            If Left(Target, 3) > 180 Then
                MsgBox "Maximum allowable values are: 180-99.9"
                Target = "000-00.0 E"
                GoTo Continue
            End If
        End If
       
        If Not Intersect(Range("F20,F22,F24"), Target) Is Nothing Then
            If Range("$F$24") < 12 Then
                MsgBox "Formula results in F24 less than 12 - please re-enter"
                Target.Select
            End If
        End If
    End If
   
Continue:
    Application.EnableEvents = True
    Exit Sub
Escape:
    MsgBox "Error " & Err.Number & ": " & Err.Description
    Resume Continue
End Sub
Click to expand...
 
Upvote 0
Understood. Try the following, if it doesn't give you what you want then let me know, but it'll be tomorrow before I can respond.
VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.CountLarge = 1 Then
        On Error GoTo Escape
        Application.EnableEvents = False
        Target = Trim(VBA.UCase(Target.Value2))
        Target.Replace ",", "."
        
        If Target.Address = "$F$15" Then
            If Not Target Like "##-##.# [N]" And Not Target Like "##-##.# [S]" Then
                MsgBox "Latitude must be entered in the format 00-00.0 N (or S)"
                Target = "00-00.0 N"
                GoTo Continue
            End If
            If Left(Target, 2) > 90 Then
                MsgBox "Maximum allowable values are: 90-99.9"
                Target = "00-00.0 N"
                GoTo Continue
            End If
        End If
        
        If Target.Address = "$F$16" Then
            If Not Target Like "###-##.# [E]" And Not Target Like "###-##.# [W]" Then
                MsgBox "Longitude must be entered in the format 000-00.0 E (or W)"
                Target = "000-00.0 E"
                GoTo Continue
            End If
            If Left(Target, 3) > 180 Then
                MsgBox "Maximum allowable values are: 180-99.9"
                Target = "000-00.0 E"
                GoTo Continue
            End If
        End If
        
        If Not Intersect(Range("F20,F22,F24"), Target) Is Nothing Then
            If Range("$F$24") < 12 Then
                MsgBox "Formula results in F24 less than 12 - please re-enter"
                Target.Select
            End If
        End If
    End If
    
Continue:
    Application.EnableEvents = True
    Exit Sub
Escape:
    MsgBox "Error " & Err.Number & ": " & Err.Description
    Resume Continue
End Sub
 
Upvote 0
Hi Kevin,

I am getting the error box now also when typing in cells F15 and F16
And also - the code below line
If Not Target Like "##-##.# [N]" And Not Target Like "##-##.# " Then
should be
If Not Target Like "##-##.# [N]" And Not Target Like "##-##.# [S]" Then
else I am getting an error when typing in the S for South

kevin9999 said:
Thanks @Akuini , I also realised that the F24 value is a result of a division of F20/F22 so I had to rewrite the entire code. @sjoerd.bosch , please try the amended code below:

VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.CountLarge = 1 Then
        On Error GoTo Escape
        Application.EnableEvents = False
        Target = Trim(VBA.UCase(Target.Value2))
        Target.Replace ",", "."
      
        If Target.Address = "$F$15" Then
            If Not Target Like "##-##.# [N]" And Not Target Like "##-##.# " Then
                MsgBox "Latitude must be entered in the format 00-00.0 N (or S)"
                Target = "00-00.0 N"
                GoTo Continue
            End If
            If Left(Target, 2) > 90 Then
                MsgBox "Maximum allowable values are: 90-99.9"
                Target = "00-00.0 N"
                GoTo Continue
            End If
        End If
      
        If Target.Address = "$F$16" Then
            If Not Target Like "###-##.# [E]" And Not Target Like "###-##.# [W]" Then
                MsgBox "Longitude must be entered in the format 000-00.0 E (or W)"
                Target = "000-00.0 E"
                GoTo Continue
            End If
            If Left(Target, 3) > 180 Then
                MsgBox "Maximum allowable values are: 180-99.9"
                Target = "000-00.0 E"
                GoTo Continue
            End If
        End If
      
        If Not Intersect(Range("F20,F22,F24"), Target) Is Nothing Then
            If Range("$F$24") < 12 Then
                MsgBox "Formula results in F24 less than 12 - please re-enter"
                Target.Select
            End If
        End If
    End If
  
Continue:
    Application.EnableEvents = True
    Exit Sub
Escape:
    MsgBox "Error " & Err.Number & ": " & Err.Description
    Resume Continue
End Sub
Click to expand...
 
Upvote 0
kevin9999 said:
Understood. Try the following, if it doesn't give you what you want then let me know, but it'll be tomorrow before I can respond.
VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.CountLarge = 1 Then
        On Error GoTo Escape
        Application.EnableEvents = False
        Target = Trim(VBA.UCase(Target.Value2))
        Target.Replace ",", "."
       
        If Target.Address = "$F$15" Then
            If Not Target Like "##-##.# [N]" And Not Target Like "##-##.# [S]" Then
                MsgBox "Latitude must be entered in the format 00-00.0 N (or S)"
                Target = "00-00.0 N"
                GoTo Continue
            End If
            If Left(Target, 2) > 90 Then
                MsgBox "Maximum allowable values are: 90-99.9"
                Target = "00-00.0 N"
                GoTo Continue
            End If
        End If
       
        If Target.Address = "$F$16" Then
            If Not Target Like "###-##.# [E]" And Not Target Like "###-##.# [W]" Then
                MsgBox "Longitude must be entered in the format 000-00.0 E (or W)"
                Target = "000-00.0 E"
                GoTo Continue
            End If
            If Left(Target, 3) > 180 Then
                MsgBox "Maximum allowable values are: 180-99.9"
                Target = "000-00.0 E"
                GoTo Continue
            End If
        End If
       
        If Not Intersect(Range("F20,F22,F24"), Target) Is Nothing Then
            If Range("$F$24") < 12 Then
                MsgBox "Formula results in F24 less than 12 - please re-enter"
                Target.Select
            End If
        End If
    End If
   
Continue:
    Application.EnableEvents = True
    Exit Sub
Escape:
    MsgBox "Error " & Err.Number & ": " & Err.Description
    Resume Continue
End Sub
Click to expand...
sorry - did not see your last nessage.
That looks better now.
Thank you once again!
 
Upvote 0
kevin9999 said:
Thanks @Akuini , I also realised that the F24 value is a result of a division of F20/F22 so I had to rewrite the entire code. @sjoerd.bosch , please try the amended code below:

VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.CountLarge = 1 Then
        On Error GoTo Escape
        Application.EnableEvents = False
        Target = Trim(VBA.UCase(Target.Value2))
        Target.Replace ",", "."
       
        If Target.Address = "$F$15" Then
            If Not Target Like "##-##.# [N]" And Not Target Like "##-##.# " Then
                MsgBox "Latitude must be entered in the format 00-00.0 N (or S)"
                Target = "00-00.0 N"
                GoTo Continue
            End If
            If Left(Target, 2) > 90 Then
                MsgBox "Maximum allowable values are: 90-99.9"
                Target = "00-00.0 N"
                GoTo Continue
            End If
        End If
       
        If Target.Address = "$F$16" Then
            If Not Target Like "###-##.# [E]" And Not Target Like "###-##.# [W]" Then
                MsgBox "Longitude must be entered in the format 000-00.0 E (or W)"
                Target = "000-00.0 E"
                GoTo Continue
            End If
            If Left(Target, 3) > 180 Then
                MsgBox "Maximum allowable values are: 180-99.9"
                Target = "000-00.0 E"
                GoTo Continue
            End If
        End If
       
        If Not Intersect(Range("F20,F22,F24"), Target) Is Nothing Then
            If Range("$F$24") < 12 Then
                MsgBox "Formula results in F24 less than 12 - please re-enter"
                Target.Select
            End If
        End If
    End If
   
Continue:
    Application.EnableEvents = True
    Exit Sub
Escape:
    MsgBox "Error " & Err.Number & ": " & Err.Description
    Resume Continue
End Sub
Click to expand...
Morning Kevin

Very sorry - but now I have a entirely different issue.
And to explain I will need to let you know that I use data from a column ranging from F6 to F51 - which is transferred to other pages
All data and restrictions / message boxes and so on are working BUT now in cell F6 & F7 - which are date and time - changes to a number when I use the latest code from you.
I have no idea why that is and where in the code this is changing. The cell is still in the custom format for dates.
All other cells are behaving as they should
Can you please check and advise?

Last code I inserted

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.CountLarge = 1 Then
On Error GoTo Escape
Application.EnableEvents = False
Target = Trim(VBA.UCase(Target.Value2))
Target.Replace ",", "."

If Target.Address = "$F$15" Then
If Not Target Like "##-##.# [N]" And Not Target Like "##-##.# " Then
MsgBox "Latitude must be entered in the format 00-00.0 N (or S)"
Target = "00-00.0 N"
GoTo Continue
End If
If Left(Target, 2) > 90 Then
MsgBox "Maximum allowable values are: 90-99.9"
Target = "00-00.0 N"
GoTo Continue
End If
End If

If Target.Address = "$F$16" Then
If Not Target Like "###-##.# [E]" And Not Target Like "###-##.# [W]" Then
MsgBox "Longitude must be entered in the format 000-00.0 E (or W)"
Target = "000-00.0 E"
GoTo Continue
End If
If Left(Target, 3) > 180 Then
MsgBox "Maximum allowable values are: 180-99.9"
Target = "000-00.0 E"
GoTo Continue
End If
End If

If Not Intersect(Range("F20,F22,F24"), Target) Is Nothing Then
If Range("$F$24") < 12 Then
MsgBox "Formula results in F24 less than 12 - please re-enter distance in Cell F20 / If the lower speed is correct, you can ignore the message and continue"
Target.Select
End If
End If
End If

Continue:
Application.EnableEvents = True
Exit Sub
Escape:
MsgBox "Error " & Err.Number & ": " & Err.Description
Resume Continue
End Sub
 
Upvote 0
sjoerd.bosch said:
Morning Kevin

Very sorry - but now I have a entirely different issue.
And to explain I will need to let you know that I use data from a column ranging from F6 to F51 - which is transferred to other pages
All data and restrictions / message boxes and so on are working BUT now in cell F6 & F7 - which are date and time - changes to a number when I use the latest code from you.
I have no idea why that is and where in the code this is changing. The cell is still in the custom format for dates.
All other cells are behaving as they should
Can you please check and advise?

Last code I inserted

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.CountLarge = 1 Then
On Error GoTo Escape
Application.EnableEvents = False
Target = Trim(VBA.UCase(Target.Value2))
Target.Replace ",", "."

If Target.Address = "$F$15" Then
If Not Target Like "##-##.# [N]" And Not Target Like "##-##.# " Then
MsgBox "Latitude must be entered in the format 00-00.0 N (or S)"
Target = "00-00.0 N"
GoTo Continue
End If
If Left(Target, 2) > 90 Then
MsgBox "Maximum allowable values are: 90-99.9"
Target = "00-00.0 N"
GoTo Continue
End If
End If

If Target.Address = "$F$16" Then
If Not Target Like "###-##.# [E]" And Not Target Like "###-##.# [W]" Then
MsgBox "Longitude must be entered in the format 000-00.0 E (or W)"
Target = "000-00.0 E"
GoTo Continue
End If
If Left(Target, 3) > 180 Then
MsgBox "Maximum allowable values are: 180-99.9"
Target = "000-00.0 E"
GoTo Continue
End If
End If

If Not Intersect(Range("F20,F22,F24"), Target) Is Nothing Then
If Range("$F$24") < 12 Then
MsgBox "Formula results in F24 less than 12 - please re-enter distance in Cell F20 / If the lower speed is correct, you can ignore the message and continue"
Target.Select
End If
End If
End If

Continue:
Application.EnableEvents = True
Exit Sub
Escape:
MsgBox "Error " & Err.Number & ": " & Err.Description
Resume Continue
End Sub
Click to expand...
There is nothing in the code that would change those cells. The only way I can see for us to progress this further is if you share your file via Google Drive, Dropbox or similar file sharing platform. Don't forget to make the file available to anyone with the link.
 
Upvote 0
Hi Kevin

I understand. Also find it strange.
And if I insert the previous codes (the one from Aquini for example) everything is working normally, except for the fact that the <12kn message box is also appearing when typing in cells F15 & F16
Dropbox or other file transfer programs are at the moment restricted for me, as PC's usage are limited here.

kevin9999 said:
There is nothing in the code that would change those cells. The only way I can see for us to progress this further is if you share your file via Google Drive, Dropbox or similar file sharing platform. Don't forget to make the file available to anyone with the link.
Click to expand...
 
Upvote 0
You must log in or register to reply here.

Similar threads

H
  • Question Question
VBA to protect/unprotect sheet...
Replies
6
Views
86
jkpieterse
jkpieterse
M
  • Question Question
Protecting Sheet from users but permitting Power Automate
Replies
1
Views
370
ExcelToDAX
E
Y
  • Question Question
Custom data validation that locks the cell as per the value in the other cell.
Replies
1
Views
269
Fluff
Fluff
J
  • Solved
Data Validation with Multiple Conditions
Replies
4
Views
704
dreid1011
dreid1011
M
  • Question Question
Data Validation using VBA and Excel function
Replies
0
Views
368
ManUBlueJay
M

Forum statistics

Threads
1,223,911
Messages
6,175,337
Members
452,637
Latest member
Ezio2866

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top