data validation

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
 
Kevin
I ran into another issue when trying to paste the code into a sheet were data and a vba code was already inserted
the cells for which I need the data have also changed - and I changed that in the code.
F20/F22 = F24
(270/24 = 11.3 and is less than 12)
but when running I get an ambitigeous name error
The vba codes required in this page is below. The name of the sheet is Daily Input


Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.CountLarge = 1 And Not Intersect(Range("F15:F16"), 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
End If

Continue:
Application.EnableEvents = True
Exit Sub
Escape:
MsgBox "Error " & Err.Number & ": " & Err.Description
Resume Continue
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.CountLarge = 1 And Not Intersect(Range("F20:F22"), Target) Is Nothing Then
On Error GoTo Escape
Application.EnableEvents = False
If Range("F24") < 12 Then
MsgBox "Formula results in D5 less than 12 - please re-enter"
Target.ClearContents
Target.Select
End If
End If
Continue:
Application.EnableEvents = True
Exit Sub
Escape:
MsgBox "Error " & Err.Number & ": " & Err.Description
Resume Continue
End Sub
What is the significance of the strike through text?
 
Upvote 0

Excel Facts

Copy a format multiple times
Select a formatted range. Double-click the Format Painter (left side of Home tab). You can paste formatting multiple times. Esc to stop
the strikes are auto inserted when copy paste. don't know why that is

The below code is forcing a user to input a specific format for Latitude and Longitude into a cell and is separate from what I additionally need for the earlier explained value.

If I paste the code you gave me into the below code - I get the ambiguous name error. I understand that there cannot be 2 worksheet_change events in one sheet, but when I try to insert your code in mine, it comes back with all sorts of errors, mainly with some statements already mentioned.
But if you check this yourself you will see for sure.

Your code on an empty sheet works fine - and that is what I checked earlier
But comined with other codes I cannot get it to work

So, I am looking to insert your code to ensure that users are aware of the fact that the value in the cell F24 is 12 or more (with the option to leave it lower if required)
The value of cell F24 is determined by Cell F20/F22

Note that all this information, both the values of the below code for lat/long and the value mention above - is displayed in one and the same column (F) in my excel form

What is the significance of the strike through text?
the code what is in the page is:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.CountLarge = 1 And Not Intersect(Range("F15:F16"), 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
End If

Continue:
Application.EnableEvents = True
Exit Sub
Escape:
MsgBox "Error " & Err.Number & ": " & Err.Description
Resume Continue
End Sub
 
Upvote 0
Please try the following:
VBA 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
        End If
        
        If Range("F24") < 12 Then
            MsgBox "Formula results in D5 less than 12 - please re-enter"
            Target.Select
    End If
Continue:
    Application.EnableEvents = True
    Exit Sub
Escape:
    MsgBox "Error " & Err.Number & ": " & Err.Description
    Resume Continue
End Sub
 
Upvote 0
That works ! Thank you so much!
Please try the following:
VBA 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
        End If
       
        If Range("F24") < 12 Then
            MsgBox "Formula results in D5 less than 12 - please re-enter"
            Target.Select
    End If
Continue:
    Application.EnableEvents = True
    Exit Sub
Escape:
    MsgBox "Error " & Err.Number & ": " & Err.Description
    Resume Continue
End Sub
 
Upvote 0
Dear Kevin.
I ran into a small issue with the below code
Now - if in cell F24 there is a value what is less than 12 - a message box keeps appearing when entering any value in any cell of the sheet.
The value less than 12 is in some circumstances permitted and I would need a command what allows me to accept - with or without a message - and then stops the message from appearing when entering other values in other cells.
Can you please assist?

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
End If

If Range("F24") < 12 Then
MsgBox "Log speed must be 12 or more if at full sea speed. Please increase the distance in cell F20. If for any reason a lower speed is correct, ignore this message"
Target.Select
End If
Continue:
Application.EnableEvents = True
Exit Sub
Escape:
MsgBox "Error " & Err.Number & ": " & Err.Description
Resume Continue
End Sub
 
Upvote 0
Actually, just change the code to this & see if it does what you want:
VBA 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
        End If
        
        If Target.Address = "$F$24" And Target < 12 Then
            MsgBox "Formula results in F24 less than 12 - please re-enter"
            Target.Select
    End If
Continue:
    Application.EnableEvents = True
    Exit Sub
Escape:
    MsgBox "Error " & Err.Number & ": " & Err.Description
    Resume Continue
End Sub
 
Upvote 0
@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
 
Upvote 0

Forum statistics

Threads
1,215,078
Messages
6,122,996
Members
449,093
Latest member
masterms

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