no decimal point if zero

[RC]

I need to restrict the data entered into a cell as below:
0 = 0
1.0 = 1
1.10 = 1.1
01.01 = 1.01
1234.1234 = 1234.1234
0234.1230 = 234.123
123456789012.1234 = 123456789012.1234
1234567890123.12345 = 123456789012.1234

the rules are: no leading or trailing zeros
zero needs to be zero not 0.0
12 digits allowed in front of the decimal and four following the
decimal

I have tried various cell formats, like ###0_._0###_)
but nothing seems to work, this can be cell formatting, a function, vb
code, whatever works

 

[Ron Rosenfeld]

I need to restrict the data entered into a cell as below:
0 = 0
1.0 = 1
1.10 = 1.1
01.01 = 1.01
1234.1234 = 1234.1234
0234.1230 = 234.123
123456789012.1234 = 123456789012.1234
1234567890123.12345 = 123456789012.1234

the rules are: no leading or trailing zeros
zero needs to be zero not 0.0
12 digits allowed in front of the decimal and four following the
decimal

I have tried various cell formats, like ###0_._0###_)
but nothing seems to work, this can be cell formatting, a function, vb
code, whatever works

Format the cell as "General"

--ron

 

[Sandy Mann]

Excel will only show 15 significant figures so you cannot get your last two
requirements. The nearest you can get without going to text is a custom
format of:

[>9999999999] #,###,###,###.####;General

--
HTH

Sandy
In Perth, the ancient capital of Scotland
and the crowning place of kings

(e-mail address removed)
Replace @mailinator.com with @tiscali.co.uk

 

[Ron Rosenfeld]

Format the cell as "General"

--ron

I did not read your rules entirely, especially with regard to limiting yourself
to a maximum of four digits after the decimal place.

You will need VBA for this.

This should get you started.

Right click on the sheet tab and select the View code option.

Paste the code below into the window that opens.

Adjust rRng to reflect the cells you wish to control.

The cells must be initially (and subsequently) formatted as text in order to
accomplish all of your requirements, as Excel cannot input numbers of more than
15 digits. (The VBA routine will handle up to about 27 digits, so should work
for you).

There are two issues unresolved pending your input.

1.

"Normal" formatting would round the last four digits so the number would be
displayed as ...1235. Do you really want it truncated?

Also, it appears as if your rule for numbers to the left of the decimal being
greater than 12, is to return only the 12 most significant digits -- but do you
want them truncated or rounded?

================================================
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rRng As Range, c As Range
Set rRng = Range("a1:a10")

If Not Intersect(Target, rRng) Is Nothing Then
Application.EnableEvents = False
For Each c In rRng
If Len(c.Value) > 0 Then
If CDec(c.Value) = Int(CDec(c.Value)) Then
c.Value = Format(CDec(c.Value), "0")
Else
c.Value = Format(CDec(c.Value), "############.####")
End If
End If
Next c
End If

Application.EnableEvents = True
End Sub
==============================================
--ron

 

[Ron Rosenfeld]

Format the cell as "General"

--ron

Actually, this routine is better.

It truncates the 12 most significant digits; then the decimal, then the first 4
decimal digits. It still rounds the fourth decimal digit, but we can change
that if you wish.

===============================
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rRng As Range, c As Range
Dim dTemp As Variant
Dim sDot As Long
Set rRng = Range("a1:a10")

If Not Intersect(Target, rRng) Is Nothing Then
Application.EnableEvents = False
For Each c In rRng
If Len(c.Value) > 0 Then
dTemp = Left(Int(CDec(c.Value)), 12)
sDot = InStr(1, c.Value, ".")
If sDot > 0 Then
c.Value = Format(dTemp & Mid(c.Value, sDot), "#.####")
Else
c.Value = Format(dTemp, "0")
End If
End If
Next c
End If

Application.EnableEvents = True
End Sub
=================================
--ron

 

[Sandy Mann]

Ron,

I assume that it is different in later versions but I find that in XL97 your
second code will only accept 11 significant digits before the decimal point
otherwise it limits the decimal places to 3.

From my testing it seems that:

dTemp & Mid(c.Value, sDot)

despite the &, is returning a real number and is therefore being truncated
to 15 significant digits *before* the Format is being applied.

The first code that you posted works *as advertised* in XL97.

--
Regards,

Sandy
In Perth, the ancient capital of Scotland
and the crowning place of kings

(e-mail address removed)
Replace @mailinator.com with @tiscali.co.uk

 

[Ron Rosenfeld]

Ron,

I assume that it is different in later versions but I find that in XL97 your
second code will only accept 11 significant digits before the decimal point
otherwise it limits the decimal places to 3.

From my testing it seems that:

dTemp & Mid(c.Value, sDot)

despite the &, is returning a real number and is therefore being truncated
to 15 significant digits *before* the Format is being applied.

The first code that you posted works *as advertised* in XL97.

Interesting. I'm running XL2002 on this machine.

Try CDec(dtemp) & Mid(c.value, sdot)

Or, for fun, I tried it using regular expressions:

Note that the re.pattern=" ... " is all on one line.

=================================
Option Explicit
Function AdjNum(str As String) As String
Dim re As Object, mc As Object
Set re = CreateObject("vbscript.regexp")
re.Pattern =
"^\D*(0)0*\D*$|^0*([1-9]\d{0,11}|0{0,12})\d*(\.(\d{3}[1-9]|\d{2}[1-9]|\d[1-9]|[1-9]))?"
Set mc = re.Execute(str)
If mc.Count >= 1 Then
AdjNum = mc(0).submatches(0) & mc(0).submatches(1) & mc(0).submatches(2)
Else
AdjNum = ""
End If
End Function
--ron

 

[Sandy Mann]

CDec(dtemp) & Mid(c.value, sdot)

Fails in the same way. Your UDF works but my Kasperski IS says that the use
of *CreateObject("vbscript.regexp")* is Risekware and can be used by hacker
to steal from my computer - good job I trust you <g>

--
Regards,

Sandy
In Perth, the ancient capital of Scotland
and the crowning place of kings

(e-mail address removed)
Replace @mailinator.com with @tiscali.co.uk

Ron,

I assume that it is different in later versions but I find that in XL97
your
second code will only accept 11 significant digits before the decimal
point
otherwise it limits the decimal places to 3.

From my testing it seems that:

dTemp & Mid(c.Value, sDot)

despite the &, is returning a real number and is therefore being truncated
to 15 significant digits *before* the Format is being applied.

The first code that you posted works *as advertised* in XL97.

Interesting. I'm running XL2002 on this machine.

Try CDec(dtemp) & Mid(c.value, sdot)

Or, for fun, I tried it using regular expressions:

Note that the re.pattern=" ... " is all on one line.

=================================
Option Explicit
Function AdjNum(str As String) As String
Dim re As Object, mc As Object
Set re = CreateObject("vbscript.regexp")
re.Pattern =
"^\D*(0)0*\D*$|^0*([1-9]\d{0,11}|0{0,12})\d*(\.(\d{3}[1-9]|\d{2}[1-9]|\d[1-9]|[1-9]))?"
Set mc = re.Execute(str)
If mc.Count >= 1 Then
AdjNum = mc(0).submatches(0) & mc(0).submatches(1) &
mc(0).submatches(2)
Else
AdjNum = ""
End If
End Function
--ron

 

[Ron Rosenfeld]

Ron,

I assume that it is different in later versions but I find that in XL97 your
second code will only accept 11 significant digits before the decimal point
otherwise it limits the decimal places to 3.

From my testing it seems that:

dTemp & Mid(c.Value, sDot)

despite the &, is returning a real number and is therefore being truncated
to 15 significant digits *before* the Format is being applied.

The first code that you posted works *as advertised* in XL97.

--
Regards,

Sandy
In Perth, the ancient capital of Scotland
and the crowning place of kings

Sandy,

There are some other issues with that Sub also -- other values it does not
handle properly (but not the issue you wrote about).

Also, version 1 allows more than 12 places to the left of the decimal.

The regular expression version actually seems to work the best; but I'm sure I
could get the other versions working properly.

Here is my test data, and the Regex output. (The REgex could certainly be
rewritten as an event-triggered Sub, but I've got it written as a function for
ease of testing).

===================================
000 0
1.0 1
1.10 1.1
01.01 1.01
1234.1234 1234.1234
0234.1230 234.123
123456789012.1234 123456789012.1234
1234567890123.12345 123456789012.1234
1234 1234
0.004 .004
..004 .004
..0000 0
============================
--ron

 

[Ron Rosenfeld]

Fails in the same way. Your UDF works but my Kasperski IS says that the use
of *CreateObject("vbscript.regexp")* is Risekware and can be used by hacker
to steal from my computer - good job I trust you <g>

I wonder how that would happen.

Here's another version that does not use CreateObject, but does require setting
a reference to VBScript Regular Expressions 5.5 (see Tools/References)

========================
Option Explicit
Function AdjNum(str As String) As String
'Requires setting Reference to Microsoft VBScript Regular Expressions 5.5
Dim re As RegExp, mc As MatchCollection
Set re = New RegExp
re.Pattern =
"^\D*(0)0*\D*$|^0*([1-9]\d{0,11}|0{0,12})\d*(\.(\d{3}[1-9]|\d{2}[1-9]|\d[1-9]|[1-9]))?"
Set mc = re.Execute(str)
If mc.Count >= 1 Then
AdjNum = mc(0).submatches(0) & mc(0).submatches(1) & mc(0).submatches(2)
Else
AdjNum = ""
End If
Set re = Nothing
End Function
==================================
--ron

 

[Sandy Mann]

Thank you very much for all the trouble that you have gone to but I ran the
first UDF by telling Kasperski to allow it to run - well you do have an
honest face.<g>

I was only using your codes as learning experiences, so you can go back to
helping people with *real* problems.

--
Regards,

Sandy
In Perth, the ancient capital of Scotland
and the crowning place of kings

(e-mail address removed)
Replace @mailinator.com with @tiscali.co.uk

Fails in the same way. Your UDF works but my Kasperski IS says that the
use
of *CreateObject("vbscript.regexp")* is Risekware and can be used by
hacker
to steal from my computer - good job I trust you <g>

I wonder how that would happen.

Here's another version that does not use CreateObject, but does require
setting
a reference to VBScript Regular Expressions 5.5 (see Tools/References)

========================
Option Explicit
Function AdjNum(str As String) As String
'Requires setting Reference to Microsoft VBScript Regular Expressions 5.5
Dim re As RegExp, mc As MatchCollection
Set re = New RegExp
re.Pattern =
"^\D*(0)0*\D*$|^0*([1-9]\d{0,11}|0{0,12})\d*(\.(\d{3}[1-9]|\d{2}[1-9]|\d[1-9]|[1-9]))?"
Set mc = re.Execute(str)
If mc.Count >= 1 Then
AdjNum = mc(0).submatches(0) & mc(0).submatches(1) &
mc(0).submatches(2)
Else
AdjNum = ""
End If
Set re = Nothing
End Function
==================================
--ron

 

[RC]

Fails in the same way.  Your UDF works but my Kasperski IS says that the use
of *CreateObject("vbscript.regexp")* is Risekware and can be used by hacker
to steal from my computer - good job I trust you <g>

I wonder how that would happen.

Here's another version that does not use CreateObject, but does require setting
a reference to VBScript Regular Expressions 5.5  (see Tools/References)

========================
Option Explicit
Function AdjNum(str As String) As String
'Requires setting Reference to Microsoft VBScript Regular Expressions 5.5
Dim re As RegExp, mc As MatchCollection
Set re = New RegExp
re.Pattern =
"^\D*(0)0*\D*$|^0*([1-9]\d{0,11}|0{0,12})\d*(\.(\d{3}[1-9]|\d{2}[1-9]|\d[1-­9]|[1-9]))?"
Set mc = re.Execute(str)
If mc.Count >= 1 Then
    AdjNum = mc(0).submatches(0) & mc(0).submatches(1) & mc(0).submatches(2)
Else
    AdjNum = ""
End If
Set re = Nothing
End Function
==================================
--ron

How do I use this Function in my worksheet, do I call it somehow from
a Worksheet_Change sub?

 

[RC]

I wonder how that would happen.

Here's another version that does not use CreateObject, but does require setting
a reference to VBScript Regular Expressions 5.5  (see Tools/References)

========================
Option Explicit
Function AdjNum(str As String) As String
'Requires setting Reference to Microsoft VBScript Regular Expressions 5.5
Dim re As RegExp, mc As MatchCollection
Set re = New RegExp
re.Pattern =
"^\D*(0)0*\D*$|^0*([1-9]\d{0,11}|0{0,12})\d*(\.(\d{3}[1-9]|\d{2}[1-9]|\d[1-­­9]|[1-9]))?"
Set mc = re.Execute(str)
If mc.Count >= 1 Then
    AdjNum = mc(0).submatches(0) & mc(0).submatches(1) & mc(0).submatches(2)
Else
    AdjNum = ""
End If
Set re = Nothing
End Function
==================================
--ron

How do I use this Function in my worksheet, do I call it somehow from
a Worksheet_Change sub?- Hide quoted text -

- Show quoted text -

I think I figured out how to use the function (user-defined funtion),
but I think I must need set the cell format differently because I get
1.23457E+11 when I type in 123456789012.1234

 

[Ron Rosenfeld]

How do I use this Function in my worksheet, do I call it somehow from
a Worksheet_Change sub?

You could, or you could just put it into a Worksheet_Change Sub, rewriting it
slightly.

If you wanted to call it from a Worksheet_Change sub, you could use something
like this:

=======================
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rRng As Range, c As Range
Set rRng = Range("A1:A10") 'alter as required
If Not Intersect(Target, rRng) Is Nothing Then
Application.EnableEvents = False
For Each c In rRng
On Error Resume Next
c.Value = AdjNum(c.Value)
Next c
Application.EnableEvents = True
End If
End Sub
===============================

There is a problem, though, that I don't yet understand. (Hence the On Error
statement.)

If I paste data into a cell in rRng, the routine crashes when trying to write
to c (on the c.value=AdjNum(c.value) statement. I'm not sure why that is
happening.

But if you use the routine and ENTER a value, as your wrote, the appropriate
alterations will be made.
--ron

 

[Ron Rosenfeld]

I think I figured out how to use the function (user-defined funtion),
but I think I must need set the cell format differently because I get
1.23457E+11 when I type in 123456789012.1234

From my first post where I proposed a UDF:

The cells must be initially (and subsequently) formatted as text in order to
accomplish all of your requirements, as Excel cannot input numbers of more than
15 digits.

--ron

 

[RC]

From my first post where I proposed a UDF:


--ron

I really appreciate all the help. I think in order to get 12 digits
before the decimal and 4 digits after the decimal I will need to
format the cells as text and then trim the characters before and after
the decimal using the Right and Left functions and trim any leading or
trailing zeros. I didn't realize about the 15 digit limit.

 

[Ron Rosenfeld]

I really appreciate all the help. I think in order to get 12 digits
before the decimal and 4 digits after the decimal I will need to
format the cells as text and then trim the characters before and after
the decimal using the Right and Left functions and trim any leading or
trailing zeros. I didn't realize about the 15 digit limit.

Both the UDF, and the event_macro, will do that trimming automatically for you.
--ron

 

[RC]

Both the UDF, and the event_macro, will do that trimming automatically foryou.
--ron

I apologize, it works great, I was not using your code correctly, I
tried it again and everything works great.
Thanks so much.

 

[Ron Rosenfeld]

I apologize, it works great, I was not using your code correctly, I
tried it again and everything works great.
Thanks so much.

Glad to hear that. Thanks for the feedback.
--ron