Automatic time conversion in the SAME cell

[Megs]

Hi,

If I key in the time "9:00:00 AM" in cell A4 and press the enter key, I
wanted cell A4 to display "3:00:00 AM". If this is possible, please tell me
the detailed procedure.

For your information, "9:00:00 AM" is the U.S. time, once I entered the
time excel in cell A4 for example, it should automatically become "3:00:00
AM" in German time in the SAME A4 cell.

Thanks in advance.

Regards,
Megs

 

[JE McGimpsey]

One way:

Put this in your worksheet code module (right-click the worksheet tab
and choose View Code from the pop-up menu):

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Const nHours As Long = 6
Dim dTimeAdjust As Double
With Target
If .Cells.Count > 1 Then Exit Sub
If .Address(False, False) = "A4" Then
If Not IsEmpty(.Value) Then
On Error Resume Next
dTimeAdjust = nHours / 24
Application.EnableEvents = False
.Value = .Value - dTimeAdjust - _
(.Value <= dTimeAdjust)
Application.EnableEvents = True
On Error GoTo 0
End If
End If
End With
End Sub

 

[Bob Phillips]

Private Sub Worksheet_Change(ByVal Target As Range)
Const WS_RANGE As String = "A4" '<=== change to suit

On Error GoTo ws_exit:
Application.EnableEvents = False
If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
With Target
If IsNumeric(.Value) Then
If .Value < 1 Then
If .Value >= TimeSerial(6, 0, 0) Then
.Value = .Value - TimeSerial(6, 0, 0)
Else
.Value = .Value + 1 - TimeSerial(6, 0, 0)
End If
End If
End If
End With
End If

ws_exit:
Application.EnableEvents = True
End Sub

'This is worksheet event code, which means that it needs to be
'placed in the appropriate worksheet code module, not a standard
'code module. To do this, right-click on the sheet tab, select
'the View Code option from the menu, and paste the code in.


--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)

 

[Megs]

Thank you Bob, it works for a single cell, but what if I wanted to specify a
range of cell? Like the following:
1. The entire workbook or
2. A4 to C22?

 

[Megs]

Thank you JE, it works for a single cell, but what if I wanted to specify a
range of cell? Like the following:
1. The entire workbook or
2. A4 to C22?

 

[Bob Phillips]

It works as the data is entered, so just change the A4 constant to A4:C22

--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)

 

[JE McGimpsey]

but what if I wanted to specify a range of cell?

Then you probably should have specified that in your problem statement,
in which you wrote about a single cell.

Any other rocks to bring?

This modification will work for A4:C22:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Const nHours As Long = 6
Dim dTimeAdjust As Double
With Target
If .Cells.Count > 1 Then Exit Sub
If Not Intersect(.Cells, Me.Range("A4:C22")) Is Nothing Then
If Not IsEmpty(.Value) Then
On Error Resume Next
dTimeAdjust = nHours / 24
Application.EnableEvents = False
.Value = .Value - dTimeAdjust - _
(.Value <= dTimeAdjust)
Application.EnableEvents = True
On Error GoTo 0
End If
End If
End With
End Sub

 

[Megs]

No more rocks, thanks JE. Problem solved.

Then you probably should have specified that in your problem statement,
in which you wrote about a single cell.

Any other rocks to bring?

This modification will work for A4:C22:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Const nHours As Long = 6
Dim dTimeAdjust As Double
With Target
If .Cells.Count > 1 Then Exit Sub
If Not Intersect(.Cells, Me.Range("A4:C22")) Is Nothing Then
If Not IsEmpty(.Value) Then
On Error Resume Next
dTimeAdjust = nHours / 24
Application.EnableEvents = False
.Value = .Value - dTimeAdjust - _
(.Value <= dTimeAdjust)
Application.EnableEvents = True
On Error GoTo 0
End If
End If
End With
End Sub

 

[Megs]

Thanks Bob. Problem solved.

It works as the data is entered, so just change the A4 constant to A4:C22

--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)