looks excellent, thanks so much
anny

"Ken Johnson" wrote in message
oups.com...
Hi anny,

You could try this Worksheet_Change Event Sub...

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
On Error GoTo ERRORHANDLER
If Target.Column = 13 _
And Target.Row 7 _
And Target.Row < 38 _
And Target.Rows.Count = 1 _
And WorksheetFunction.IsNumber(Target.Value) _
And Target.Value < 10 _
And Mid(Target.Value, 2, 1) < "." Then
Application.EnableEvents = False
Dim strX() As String
Dim sShownValue As Single
Dim I As Byte
ReDim Preserve strX(1 To Len(Target.Value))
For I = 1 To UBound(strX)
strX(I) = Mid(CStr(Target.Value), I, 1)
Next
Select Case UBound(strX)
Case 1
sShownValue = CSng(strX(1) & "." & "000")
Case 2
sShownValue = CSng(strX(1) & "." & strX(2) & "00")
Case 3
sShownValue = CSng(strX(1) & "." & strX(2) & strX(3) & "0")
Case 4
sShownValue = CSng(strX(1) & "." & strX(2) & strX(3) & strX(4))
End Select
Target.Value = WorksheetFunction.Round(sShownValue, 3)
End If
If Target.Cells(1, 1).Value = 0 Then
Application.EnableEvents = False
Target.Cells(1, 1).ClearContents
Application.EnableEvents = True
Beep
Target.Select
End If
Application.EnableEvents = True
Exit Sub
ERRORHANDLER: Application.EnableEvents = True
End Sub


If the user enters a value with more than 4 digits the code assumes a
mistake has been made. The entry is cleared, the cell is reselected and
a beep is sounded.
If the user uses the decimal point, the code is skipped and the entry
is as usual.
If 10 is entered the code is skipped and it apears as 10.000.

Ken Johnson