data validation

[sjoerd.bosch]

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

 

[kevin9999]

Unfortunately, there's no obvious explanation for that new behavior, and without the file I can't help you any further.

 

[Akuini]

@kevin9999
I think you should keep "And Not Intersect(Range("F15:F16, F20,F22,F24"), Target) Is Nothing Then" :

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

otherwise this part will be executed in any cell that changes :

On Error GoTo Escape
Application.EnableEvents = False
Target = Trim(VBA.UCase(Target.Value2))
Target.Replace ",", "."

 

[sjoerd.bosch]

Hi
So what part of the below code should be changed then?
At the moment the only hickup I am having is that the msg box pops up when typing in Cells F15 &F16 - While it should only appear when the cell F20 and cell F22 (which gives the <12 result in cell F24
Everything else is working fine


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

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

End If

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

@kevin9999
I think you should keep "And Not Intersect(Range("F15:F16, F20,F22,F24"), Target) Is Nothing Then" :

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

otherwise this part will be executed in any cell that changes :

On Error GoTo Escape
Application.EnableEvents = False
Target = Trim(VBA.UCase(Target.Value2))
Target.Replace ",", "."

 

[kevin9999]

Good point @Akuini - you're absolutely right
Let's try this:

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 "##-##.# [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

 

[sjoerd.bosch]

Good point @Akuini - you're absolutely right
Let's try this:

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 "##-##.# [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

That is now working 100%
Thank you guys for helping out. Much appreciated!!!!

 

[kevin9999]

Glad we were able to help