Want Fixed Decimal places in only 1 column

G

Guest

I've seen alot of traffic regarding fixed decimal places. I'm aware I can
have fixed decimal places throughout the worksheet; however, I only want
fixed decimal places in one column.
I want to be able to enter 735 and get 7.35
Or 1234 and get 12.34
Or 12345 and get 123.45
So, 2 fixed decimals but only in this column

I have found a VB program on this discussion group in the past that helped
me format time so that I only have to enter 700 and it returns 7:00 AM
or 1300 = 1:00pm.

Since I don't understand VB well, I tried to utilize the same program to do
what I'm requesting above. Below is the VB code which includes the first
range for time entry and NewRange1 where I was attempting to modify the code
for number entry with 2 fixed decimals. Based on the code modifications,
unfortunately, when I enter a number 735, I get 735.35 or 1234 I get 1234.34
Can someone PLEASE look at this code and make the changes to support my
requirements? I will not be entering any numbers longer than the 4 Cases
shown.
Thanks



Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As
Excel.Range)


On Error GoTo EndMacro
If Application.Intersect(Target, Range("C8:C38")) Is Nothing Then
GoTo NewRange1
End If
If Target.Cells.Count > 1 Then
GoTo NewRange1
End If
If Target.Value = "" Then
GoTo NewRange1
End If

Application.EnableEvents = False
With Target
If .HasFormula = False Then
Select Case Len(.Value)
Case 1 ' e.g., 1 = 00:01 AM
TimeStr = "00:0" & .Value
Case 2 ' e.g., 12 = 00:12 AM
TimeStr = "00:" & .Value
Case 3 ' e.g., 735 = 7:35 AM
TimeStr = Left(.Value, 1) & ":" & _
Right(.Value, 2)
Case 4 ' e.g., 1234 = 12:34
TimeStr = Left(.Value, 2) & ":" & _
Right(.Value, 2)
Case 5 ' e.g., 12345 = 1:23:45 NOT 12:03:45
TimeStr = Left(.Value, 1) & ":" & _
Mid(.Value, 2, 2) & ":" & Right(.Value, 2)
Case 6 ' e.g., 123456 = 12:34:56
TimeStr = Left(.Value, 2) & ":" & _
Mid(.Value, 3, 2) & ":" & Right(.Value, 2)
Case Else
Err.Raise 0
End Select
.Value = TimeValue(TimeStr)
End If
End With

Application.EnableEvents = True




'Starting new Range

NewRange1:

If Application.Intersect(Target, Range("H8:H38")) Is Nothing Then
Exit Sub
End If
If Target.Cells.Count > 1 Then
Exit Sub
End If
If Target.Value = "" Then
Exit Sub
End If

Application.EnableEvents = False
With Target
If .HasFormula = False Then
Select Case Len(.Value)
Case 1 ' e.g., 735 = 7.35
TimeStr = Left(.Value, 1) & "." & _
Right(.Value, 2)
Case 2 ' e.g., 1234 = 12.34
TimeStr = Left(.Value, 2) & "." & _
Right(.Value, 2)
Case 3 ' e.g., 12345 = 123.45
TimeStr = Left(.Value, 3) & "." & _
Right(.Value, 2)
Case 4 ' e.g., 123456 = 1234.56
TimeStr = Left(.Value, 4) & "." & _
Right(.Value, 2)
Case Else
Err.Raise 0
End Select
.Value = (TimeStr)
End If
End With

Application.EnableEvents = True


Exit Sub

EndMacro:
MsgBox "You Did Not Enter a Valid AM Time; IF You Have Entered PM Time -
Disregard"
Application.EnableEvents = True
End Sub
 
D

Dave Peterson

Maybe something like:

Option Explicit
Private Sub Workbook_SheetChange(ByVal Sh As Object, _
ByVal Target As Excel.Range)

Dim TimeStr As String

With Target
'one cell at a time
If .Cells.Count > 1 Then Exit Sub
'no formulas
If .HasFormula = True Then Exit Sub
'no empty cells
If .Value = "" Then Exit Sub
'only numbers
If IsNumeric(.Value) = False Then Exit Sub

On Error GoTo EndMacro:

Application.EnableEvents = False

If Not (Intersect(.Cells, Sh.Range("C8:C38")) Is Nothing) Then
Select Case Len(.Value)
Case 1 ' e.g., 1 = 00:01 AM
TimeStr = "00:0" & .Value
Case 2 ' e.g., 12 = 00:12 AM
TimeStr = "00:" & .Value
Case 3 ' e.g., 735 = 7:35 AM
TimeStr = Left(.Value, 1) & ":" & _
Right(.Value, 2)
Case 4 ' e.g., 1234 = 12:34
TimeStr = Left(.Value, 2) & ":" & _
Right(.Value, 2)
Case 5 ' e.g., 12345 = 1:23:45 NOT 12:03:45
TimeStr = Left(.Value, 1) & ":" & _
Mid(.Value, 2, 2) & ":" & Right(.Value, 2)
Case 6 ' e.g., 123456 = 12:34:56
TimeStr = Left(.Value, 2) & ":" & _
Mid(.Value, 3, 2) & ":" & Right(.Value, 2)
Case Else
Err.Raise 0
End Select
.Value = TimeValue(TimeStr)
Else
If Intersect(.Cells, Sh.Range("H8:H38")) Is Nothing Then
.Value = .Value / 100
End If
End If
End With

EndMacro:
Application.EnableEvents = True
End Sub

You are using a workbook event--so this affects all the worksheets in the
workbook, right?
 
G

Guest

Dave, I didn't do it exactly like you but it sparked a way for me to do this.
Below is the code for just the Fixed Decimal 2 spaces (I deleted the time
formating for this example). I think this would be very helpful for many
people I have seen post issues with the Fixed 2 Decimal issues and they don't
want to set the Decimals across the entire worksheet. Really appreciate your
help - Mike

If Application.Intersect(Target, Range("H8:H38")) Is Nothing Then
Exit Sub
End If
If Target.Cells.Count > 1 Then
Exit Sub
End If
If Target.Value = "" Then
Exit Sub
End If

Application.EnableEvents = False
With Target
If .HasFormula = False Then
.Value = (.Value / 100)
End If
End With

Application.EnableEvents = True

Exit Sub

EndMacro:
MsgBox "You Did Not Enter a Valid Pressure Reading"
Application.EnableEvents = True
End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top