Help with Sub's on a worksheet
 

I've gotten a lot of help with this problem, but I still can't get it to
work. I have the following code on sheet 1, and I know that it doesn't work,
but I'm not sure how to fix it. I realize that I can't have two
Worksheet_Change subs on the same sheet, and both work if they stand alone.
Any help would be appreciated. Thanks

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("K18:K37")) Is Nothing Then Exit Sub
Application.EnableEvents = False
On Error Resume Next

' Check to see if a past action is occuring
If Application.CutCopyMode = xlCopy Or _
Application.CutCopyMode = xlCut Then

Application.Undo
Selection.PasteSpecial Paste:=xlPasteValues
End If

Application.EnableEvents = True

End Sub
¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬ ¬¬¬¬-__________________________________________________ __________________________________________

Private Sub Worksheet_Change(ByVal Target As Excel.Range)

Dim TimeStr As String

If Target.Address = "$J$2" Then Call selectthecase

On Error GoTo EndMacro
If Application.Intersect(Target,
Range("L6:M61,E48:F61,D73:D83,D87:D105,L87:L93,M73 :M83,D6:D24,D28:D43,B109:B127")) 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
€˜ A number of Select Case stuff goes in here
End Select
.Value = TimeValue(TimeStr)
End If
End With
Application.EnableEvents = True
Exit Sub
EndMacro:
MsgBox "You did not enter a valid time"
Application.EnableEvents = True
End Sub

--
Howard

Help with Sub's on a worksheet
 

So what is your objective? What do you expect to happen when the code runs?


"Howard" wrote in message
...
I've gotten a lot of help with this problem, but I still can't get it to
work. I have the following code on sheet 1, and I know that it doesn't
work,
but I'm not sure how to fix it. I realize that I can't have two
Worksheet_Change subs on the same sheet, and both work if they stand
alone.
Any help would be appreciated. Thanks

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("K18:K37")) Is Nothing Then Exit Sub
Application.EnableEvents = False
On Error Resume Next

' Check to see if a past action is occuring
If Application.CutCopyMode = xlCopy Or _
Application.CutCopyMode = xlCut Then

Application.Undo
Selection.PasteSpecial Paste:=xlPasteValues
End If

Application.EnableEvents = True

End Sub
¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬-__________________________________________________ __________________________________________

Private Sub Worksheet_Change(ByVal Target As Excel.Range)

Dim TimeStr As String

If Target.Address = "$J$2" Then Call selectthecase

On Error GoTo EndMacro
If Application.Intersect(Target,
Range("L6:M61,E48:F61,D73:D83,D87:D105,L87:L93,M73 :M83,D6:D24,D28:D43,B109:B127"))
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
' A number of Select Case stuff goes in here
End Select
.Value = TimeValue(TimeStr)
End If
End With
Application.EnableEvents = True
Exit Sub
EndMacro:
MsgBox "You did not enter a valid time"
Application.EnableEvents = True
End Sub

--
Howard

Help with Sub's on a worksheet
 

Hi Howard

Combined to one Sub this should work:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim TimeStr As String

If Not Intersect(Target, Range("K18:K37")) Is Nothing Then
On Error Resume Next
' Check to see if a past action is occuring
If Application.CutCopyMode = xlCopy Or _
Application.CutCopyMode = xlCut Then

Application.EnableEvents = False
Application.Undo
Selection.PasteSpecial Paste:=xlPasteValues
Application.EnableEvents = True
End If
End If

On Error GoTo EndMacro
If Not Application.Intersect(Target, _
Range("L6:M61,E48:F61,D73:D83,D87:D105,L87:L93,M73 :M83,D6:D24,D28:D43,B109:B127"))
_
Is Nothing Then

If Target.Cells.Count 1 Then Exit Sub
If Target.Value = "" Then Exit Sub

Application.EnableEvents = False
With Target
If .HasFormula = False Then
' A number of Select Case stuff goes in here
End Select
.Value = TimeValue(TimeStr)
End If
End With
Application.EnableEvents = True
Exit Sub
End If
If Target.Address = "$J$2" Then Call selectthecase
Exit Sub

EndMacro:
MsgBox "You did not enter a valid time"
Application.EnableEvents = True
End Sub

Regards,
Per

"Howard" skrev i meddelelsen
...
I've gotten a lot of help with this problem, but I still can't get it to
work. I have the following code on sheet 1, and I know that it doesn't
work,
but I'm not sure how to fix it. I realize that I can't have two
Worksheet_Change subs on the same sheet, and both work if they stand
alone.
Any help would be appreciated. Thanks

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("K18:K37")) Is Nothing Then Exit Sub
Application.EnableEvents = False
On Error Resume Next

' Check to see if a past action is occuring
If Application.CutCopyMode = xlCopy Or _
Application.CutCopyMode = xlCut Then

Application.Undo
Selection.PasteSpecial Paste:=xlPasteValues
End If

Application.EnableEvents = True

End Sub
¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬ ¬¬¬¬-__________________________________________________ __________________________________________

Private Sub Worksheet_Change(ByVal Target As Excel.Range)

Dim TimeStr As String

If Target.Address = "$J$2" Then Call selectthecase

On Error GoTo EndMacro
If Application.Intersect(Target,
Range("L6:M61,E48:F61,D73:D83,D87:D105,L87:L93,M73 :M83,D6:D24,D28:D43,B109:B127"))
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
€˜ A number of Select Case stuff goes in here
End Select
.Value = TimeValue(TimeStr)
End If
End With
Application.EnableEvents = True
Exit Sub
EndMacro:
MsgBox "You did not enter a valid time"
Application.EnableEvents = True
End Sub

--
Howard

Help with Sub's on a worksheet
 

Try this. Step through it to see if it's what you really want.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim myRange As Excel.Range
Dim TimeStr As String

Application.EnableEvents = False
Set myRange = Me.Range("K18:K37")

If Not Intersect(Target, myRange) Is Nothing Then


' Check to see if a paste action is occuring
If Application.CutCopyMode = xlCopy Or _
Application.CutCopyMode = xlCut Then
Application.Undo
Target.PasteSpecial Paste:=xlPasteValues
End If

End If

'End of worksheet change 1

If Target.Address = "$J$2" Then Call SelectTheCase 'This was not provided

Set myRange = Me.Range("L6:M61,E48:F61,D73:D83,D87:D105," & _
"L87:L93 , M73:M83 , D6:D24 , D28:D43 , B109:B127 ")
If Not Application.Intersect(Target, myRange) Is Nothing Then

If Target.Cells.Count 1 Then Exit Sub
If Target.Value = "" Then Exit Sub

If TimeStr < "" Then
With Target
If .HasFormula = False Then
' A number of Select Case stuff goes in here
'End Select 'no select case so commented out
.Value = TimeValue(TimeStr) 'where does TimeStr come from?
End If
End With
Else
MsgBox "You did not enter a valid time"

End If
End If
Application.EnableEvents = True

End Sub
--
HTH,

Barb Reinhardt



"Howard" wrote:

I've gotten a lot of help with this problem, but I still can't get it to
work. I have the following code on sheet 1, and I know that it doesn't work,
but I'm not sure how to fix it. I realize that I can't have two
Worksheet_Change subs on the same sheet, and both work if they stand alone.
Any help would be appreciated. Thanks

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("K18:K37")) Is Nothing Then Exit Sub
Application.EnableEvents = False
On Error Resume Next

' Check to see if a past action is occuring
If Application.CutCopyMode = xlCopy Or _
Application.CutCopyMode = xlCut Then

Application.Undo
Selection.PasteSpecial Paste:=xlPasteValues
End If

Application.EnableEvents = True

End Sub
¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬ ¬¬¬¬-__________________________________________________ __________________________________________

Private Sub Worksheet_Change(ByVal Target As Excel.Range)

Dim TimeStr As String

If Target.Address = "$J$2" Then Call selectthecase

On Error GoTo EndMacro
If Application.Intersect(Target,
Range("L6:M61,E48:F61,D73:D83,D87:D105,L87:L93,M73 :M83,D6:D24,D28:D43,B109:B127")) 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
€˜ A number of Select Case stuff goes in here
End Select
.Value = TimeValue(TimeStr)
End If
End With
Application.EnableEvents = True
Exit Sub
EndMacro:
MsgBox "You did not enter a valid time"
Application.EnableEvents = True
End Sub

--
Howard

Help with Sub's on a worksheet
 

Thanks Barb, I'll give this a try. It looks good to me.
--
Howard


"Barb Reinhardt" wrote:

Try this. Step through it to see if it's what you really want.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim myRange As Excel.Range
Dim TimeStr As String

Application.EnableEvents = False
Set myRange = Me.Range("K18:K37")

If Not Intersect(Target, myRange) Is Nothing Then


' Check to see if a paste action is occuring
If Application.CutCopyMode = xlCopy Or _
Application.CutCopyMode = xlCut Then
Application.Undo
Target.PasteSpecial Paste:=xlPasteValues
End If

End If

'End of worksheet change 1

If Target.Address = "$J$2" Then Call SelectTheCase 'This was not provided

Set myRange = Me.Range("L6:M61,E48:F61,D73:D83,D87:D105," & _
"L87:L93 , M73:M83 , D6:D24 , D28:D43 , B109:B127 ")
If Not Application.Intersect(Target, myRange) Is Nothing Then

If Target.Cells.Count 1 Then Exit Sub
If Target.Value = "" Then Exit Sub

If TimeStr < "" Then
With Target
If .HasFormula = False Then
' A number of Select Case stuff goes in here
'End Select 'no select case so commented out
.Value = TimeValue(TimeStr) 'where does TimeStr come from?
End If
End With
Else
MsgBox "You did not enter a valid time"

End If
End If
Application.EnableEvents = True

End Sub
--
HTH,

Barb Reinhardt



"Howard" wrote:

I've gotten a lot of help with this problem, but I still can't get it to
work. I have the following code on sheet 1, and I know that it doesn't work,
but I'm not sure how to fix it. I realize that I can't have two
Worksheet_Change subs on the same sheet, and both work if they stand alone.
Any help would be appreciated. Thanks

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("K18:K37")) Is Nothing Then Exit Sub
Application.EnableEvents = False
On Error Resume Next

' Check to see if a past action is occuring
If Application.CutCopyMode = xlCopy Or _
Application.CutCopyMode = xlCut Then

Application.Undo
Selection.PasteSpecial Paste:=xlPasteValues
End If

Application.EnableEvents = True

End Sub
¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬ ¬¬¬¬-__________________________________________________ __________________________________________

Private Sub Worksheet_Change(ByVal Target As Excel.Range)

Dim TimeStr As String

If Target.Address = "$J$2" Then Call selectthecase

On Error GoTo EndMacro
If Application.Intersect(Target,
Range("L6:M61,E48:F61,D73:D83,D87:D105,L87:L93,M73 :M83,D6:D24,D28:D43,B109:B127")) 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
€˜ A number of Select Case stuff goes in here
End Select
.Value = TimeValue(TimeStr)
End If
End With
Application.EnableEvents = True
Exit Sub
EndMacro:
MsgBox "You did not enter a valid time"
Application.EnableEvents = True
End Sub

--
Howard