View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
Fred[_22_] Fred[_22_] is offline
external usenet poster
 
Posts: 13
Default VBA help please !

Anthony, just copy the whole sub to the workbook using the
Workbook_SheetChange event.
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

It will then apply to all sheets in the workbook. If you only want it to
apply to certain sheets then you can test which sheet caused the event from
the 'Sh' parameter.

Fred

"Anthony" wrote in message
...
Hi,
I have a workbook containing 7 pages (one for each day of week), on each
one I want the user to input the 'time' in a certain manner. I have the
code
below which works. However I have to place the code into each VBA editor
sheet relating to that particular day, hence I have the code in the VBA
editor 7 times. Is there a place to place it just once so that it will
work
on the entire workbook. I have tried placing it ion the thisworkbook page
without any joy.
the code I am using is :-

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Application.EnableEvents = False
With Target
If .Count = 1 Then
.Value = UCase(.Value)
End If
End With
Application.EnableEvents = True

Dim TimeStr As String

On Error GoTo EndMacro
If Application.Intersect(Target, Range("C8:C100,J8:J100")) 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 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)

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
Exit Sub
EndMacro:
MsgBox "You entered an invalid time - Please re-enter again eg 0936 for
9.36am or 2150 for 9.50pm"
Application.EnableEvents = True
End Sub


Thankd for any help