How to combine two Private Sub Worksheet_Change for one sheet

Nitil

New Member
Joined
May 8, 2021
Messages
5
Office Version
  1. 2019
Platform
  1. Windows
I am looking for two Private Sub Worksheet_Change for one sheet.
I need these to both to work, but can only get the first one to work.
Is there a way to get these to work by combining them somehow?

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("C4:C6")) Is Nothing Or Target.Value <> True Then Exit Sub
Debug.Print Target.Address
Dim HypTime As Date
Dim StartTime As Date, EndTime As Date

' get time period for changes
StartTime = Range("F1").Value
EndTime = Range("F2").Value
'set criteria met time
HypTime = Format(Now(), "hh:mm")

If (HypTime >= StartTime) And (HypTime <= EndTime) Then
' if True added between start and end times, add 1 to Number of Counts and record time
Cells(Target.Row, 6) = Cells(Target.Row, 6) + 1
Cells(Target.Row, 7) = HypTime
End If

End Sub

If Intersect(Target, Range("E4:E6")) Is Nothing Or Target.Value <> True Then Exit Sub
Debug.Print Target.Address
Dim HypTime As Date
Dim StartTime As Date, EndTime As Date

' get time period for changes
StartTime = Range("F1").Value
EndTime = Range("F2").Value
'set criteria met time
HypTime = Format(Now(), "hh:mm")

If (HypTime >= StartTime) And (HypTime <= EndTime) Then
' if True added between start and end times, add 1 to Number of Counts and record time
Cells(Target.Row, 9) = Cells(Target.Row, 9) + 1
Cells(Target.Row, 10) = HypTime
End If

End Sub

Excel 2019 and Windows 10

Thanks
 

Excel Facts

Can you sort left to right?
To sort left-to-right, use the Sort dialog box. Click Options. Choose "Sort left to right"
Welcome to MrExcel Message Board.
I think This work for you:
VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Union(Range("C4:C6"), Range("E4:E6"))) Is Nothing Or Target.Value <> True Then Exit Sub
If Not Intersect(Target, Range("C4:C6")) Is Nothing Or Target.Value <> True Then
Debug.Print Target.Address
Dim HypTime As Date
Dim StartTime As Date, EndTime As Date

' get time period for changes
StartTime = Range("F1").Value
EndTime = Range("F2").Value
'set criteria met time
HypTime = Format(Now(), "hh:mm")

If (HypTime >= StartTime) And (HypTime <= EndTime) Then
' if True added between start and end times, add 1 to Number of Counts and record time
Cells(Target.Row, 6) = Cells(Target.Row, 6) + 1
Cells(Target.Row, 7) = HypTime
End If
End If

If Not Intersect(Target, Range("E4:E6")) Is Nothing Or Target.Value <> True Then
Debug.Print Target.Address
Dim HypTime As Date
Dim StartTime As Date, EndTime As Date

' get time period for changes
StartTime = Range("F1").Value
EndTime = Range("F2").Value
'set criteria met time
HypTime = Format(Now(), "hh:mm")

If (HypTime >= StartTime) And (HypTime <= EndTime) Then
' if True added between start and end times, add 1 to Number of Counts and record time
Cells(Target.Row, 9) = Cells(Target.Row, 9) + 1
Cells(Target.Row, 10) = HypTime
End If
End If
End Sub
 
Upvote 0
Hi Nitil,

mabe like this:
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim HypTime As Date
Dim StartTime As Date
Dim EndTime As Date
Dim lngTargCol As Long

' get time period for changes
StartTime = Range("F1").Value
EndTime = Range("F2").Value
'set criteria met time
HypTime = Format(Now(), "hh:mm")

If Intersect(Target, Range("C4:C6,E4:E6")) Is Nothing Or Target.Value <> True Then
  Exit Sub
Else
  Debug.Print Target.Address
 
  If (HypTime >= StartTime) And (HypTime <= EndTime) Then
    If Target.Column = 3 Then
      lngTargCol = 6
    Else
      lngTargCol = 9
    End If
    ' if True added between start and end times, add 1 to Number of Counts and record time
    Cells(Target.Row, lngTargCol) = Cells(Target.Row, lngTargCol) + 1
    Cells(Target.Row, lngTargCol + 1) = HypTime
  End If
End If

End Sub

You should consider to restrict changes to be made to just one cell at a time.

Ciao,
Holger
 
Upvote 0
Welcome to MrExcel Message Board.
I think This work for you:
VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Union(Range("C4:C6"), Range("E4:E6"))) Is Nothing Or Target.Value <> True Then Exit Sub
If Not Intersect(Target, Range("C4:C6")) Is Nothing Or Target.Value <> True Then
Debug.Print Target.Address
Dim HypTime As Date
Dim StartTime As Date, EndTime As Date

' get time period for changes
StartTime = Range("F1").Value
EndTime = Range("F2").Value
'set criteria met time
HypTime = Format(Now(), "hh:mm")

If (HypTime >= StartTime) And (HypTime <= EndTime) Then
' if True added between start and end times, add 1 to Number of Counts and record time
Cells(Target.Row, 6) = Cells(Target.Row, 6) + 1
Cells(Target.Row, 7) = HypTime
End If
End If

If Not Intersect(Target, Range("E4:E6")) Is Nothing Or Target.Value <> True Then
Debug.Print Target.Address
Dim HypTime As Date
Dim StartTime As Date, EndTime As Date

' get time period for changes
StartTime = Range("F1").Value
EndTime = Range("F2").Value
'set criteria met time
HypTime = Format(Now(), "hh:mm")

If (HypTime >= StartTime) And (HypTime <= EndTime) Then
' if True added between start and end times, add 1 to Number of Counts and record time
Cells(Target.Row, 9) = Cells(Target.Row, 9) + 1
Cells(Target.Row, 10) = HypTime
End If
End If
End Sub
It is showing below error:
Compile error
Duplicate declaration in current scope
Dim HypTime As Date.
Please help
 

Attachments

  • Capture Error.PNG
    Capture Error.PNG
    26.5 KB · Views: 2
Upvote 0
Hi Nitil,

just cut the indicated code lines:
Code:
If Not Intersect(Target, Range("E4:E6")) Is Nothing Or Target.Value <> True Then
Debug.Print Target.Address
Dim HypTime As Date 'cut this line off, doubled up
Dim StartTime As Date, EndTime As Date 'cut this line off, doubled up
Ciao,
Holger
 
Upvote 0
Try this short Code:
VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Union(Range("C4:C6"), Range("E4:E6"))) Is Nothing Or Target.Value <> True Then Exit Sub
Debug.Print Target.Address
Dim HypTime As Date
Dim StartTime As Date, EndTime As Date

' get time period for changes
StartTime = Range("F1").Value
EndTime = Range("F2").Value
'set criteria met time
HypTime = Format(Now(), "hh:mm")

If (HypTime >= StartTime) And (HypTime <= EndTime) Then
' if True added between start and end times, add 1 to Number of Counts and record time
If Target.Column = 3 Then
Cells(Target.Row, 6) = Cells(Target.Row, 6) + 1
Cells(Target.Row, 7) = HypTime
ElseIf Taget.Column = 5 Then
Cells(Target.Row, 9) = Cells(Target.Row, 9) + 1
Cells(Target.Row, 10) = HypTime
End If
End If
End Sub
 
Upvote 0
Hi,
untested but another way maybe

VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rng         As Range
    Dim Col         As Integer
    Dim HypTime     As Date
    Dim StartTime   As Date, EndTime As Date
    
    On Error GoTo exitsub
    Set rng = Range("C4:C6,E4:E6")
    
    If Intersect(Target, rng) Is Nothing Or Target.Value <> True Then Exit Sub
    Col = IIf(Not Intersect(Target, rng.Areas(1)) Is Nothing, 6, 9)
    
    ' get time period for changes
    StartTime = Range("F1").Value
    EndTime = Range("F2").Value
    'set criteria met time
    HypTime = Format(Now(), "hh:mm")
    
    If (HypTime >= StartTime) And (HypTime <= EndTime) Then
        Application.EnableEvents = False
        ' if True added between start and end times, add 1 to Number of Counts and record time
        Cells(Target.Row, Col) = Cells(Target.Row, Col) + 1
        Cells(Target.Row, Col + 1) = HypTime
    End If
    
exitsub:
    Application.EnableEvents = True
End Sub

Dave
 
Upvote 0

Forum statistics

Threads
1,213,543
Messages
6,114,243
Members
448,555
Latest member
RobertJones1986

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top