forcing a specific format into an excel cell [not used for calculation]

[sjoerdbosch]

I am trying to have users entering a specific format into a cell using a decimal and not a comma as separator.

A very helpful member got this far, but unfortunately it is not working for me.

I need the following entered into a cell [F15] for example: 16-15.2 N and in cell F16 for example 008-12.6 E - NOT 16-15,2 N [with a comma instead of a decimal point.
These are coordinates and used for noting down a position at certain times. F15 is Latitude and F16 is longitude - Lat is either N or S and Longitude is either E or W
In the below code I am getting an error if entered what I want and it works if I use a comma instead of a decimal.

Also the letters N.S.E.W should be in upper case

I could also use a formula in data what forces the specific format.

I am using excel 365 and 2016 - on both versions it does the same

If anyone could please assist - much appreciated

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lati As Range, longi As Range, cell As Range, s, s1
Set lati = Range("F15") ' change to actual cells
Set longi = Range("F16") ' change to actual cells
If Intersect(Target, Union(lati, longi)) Is Nothing Then Exit Sub
For Each cell In Target
On Error GoTo z
s = Split(cell, "-"): s1 = Split(s(1))
If Not Intersect(cell, lati) Is Nothing Then
If s(0) > 90 Or s1(0) > 99.9 Or Len(s1(0)) <> 4 Or (s1(1) <> "N" And s1(1) <> "S") Then GoTo z
Else
If s(0) > 180 Or s1(0) > 99.9 Or Len(s1(0)) <> 4 Or (s1(1) <> "E" And s1(1) <> "W") Then GoTo z
End If
GoTo y
z:
Application.EnableEvents = False
cell.ClearContents
Application.EnableEvents = True
MsgBox "Must be 90-99.9 N/S (latitude) or 180-99.9 E/W (longitude)"
y:
Next
End Sub

 

[kevin9999]

Try this to start and see how close it is getting you to your desired result:

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 = VBA.UCase(Target.Value2)
        Target.Replace ",", "."
    End If
    
Continue:
    Application.EnableEvents = True
    Exit Sub
Escape:
    MsgBox "Error " & Err.Number & ": " & Err.Description
    Resume Continue
End Sub

 

[sjoerdbosch]

Hi Kevin,

Okay that is actually changing the comma into a digital and capitalizes the letters, which good.
But it allows nearly anything to enter in the cells.

Is there a way to force the format to be:
In cell F15 - Lat: 00-00.0 N or S (max allowable 90-99.9 N or S - example 16-52.2 N
In cell F16 - long: 000-00.0 E or W (max allowable 180-99.9 E or W example 152-12.8 E

 

[kevin9999]

There's probably a more elegant way of doing it than this, but see if this gets closer to what you want.

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 "##-##.# [S]" Then
                MsgBox "Latitude must be entered in the format 00-00.0 N (or S)"
                Target = "Re-enter"
                GoTo Continue
            End If
            If Left(Target, 2) > 90 Then
                MsgBox "Maximum allowable values are: 90-99.9"
                Target = "Re-enter"
                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 = "Re-enter"
                GoTo Continue
            End If
            If Left(Target, 3) > 180 Then
                MsgBox "Maximum allowable values are: 180-99.9"
                Target = "Re-enter"
                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

 

[kevin9999]

Might be better to give the user a bit more of a guide when they get it wrong...

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 "##-##.# [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
    End If
    
Continue:
    Application.EnableEvents = True
    Exit Sub
Escape:
    MsgBox "Error " & Err.Number & ": " & Err.Description
    Resume Continue
End Sub

 

[sjoerdbosch]

that works brilliantly.
Thank you so much!

 

[kevin9999]

that works brilliantly.
Thank you so much!

Happy to have helped, & thanks for the feedback

 

[sjoerdbosch]

sorry - running into trouble if I put the code in a different named worksheet
I have sheet called Daily Input and Voy.Report

 

[kevin9999]

sorry - running into trouble if I put the code in a different named worksheet
I have sheet called Daily Input and Voy.Report

The name(s) of the worksheet aren't referenced in a Worksheet_Change event code - they work on whatever sheet you put the code. As long as the cell references match what the code says (F15/F16) then the code will work on any sheet. If you want to apply this code to several sheets, you will need to copy the code to the code areas of each of those sheets (again, make sure the cell references still match).

 

[sjoerdbosch]

Ignore that last message. Didn't copy the entire code

The name(s) of the worksheet aren't referenced in a Worksheet_Change event code - they work on whatever sheet you put the code. As long as the cell references match what the code says (F15/F16) then the code will work on any sheet. If you want to apply this code to several sheets, you will need to copy the code to the code areas of each of those sheets (again, make sure the cell references still match).

Hi Kevin,

Sorry. Yes it works fine now. Many thanks once again!