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

Control Word Wrap
Press Alt+Enter to move to a new row in a cell. Lets you control where the words wrap.

maabadi

Well-known Member
Joined
Oct 22, 2012
Messages
2,555
Office Version
  1. 2019
  2. 2016
Platform
  1. Windows
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
 

HaHoBe

Active Member
Joined
Jan 24, 2003
Messages
497
Office Version
  1. 2013
Platform
  1. Windows
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
 

Nitil

New Member
Joined
May 8, 2021
Messages
5
Office Version
  1. 2019
Platform
  1. Windows
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: 1

HaHoBe

Active Member
Joined
Jan 24, 2003
Messages
497
Office Version
  1. 2013
Platform
  1. Windows

ADVERTISEMENT

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
 

maabadi

Well-known Member
Joined
Oct 22, 2012
Messages
2,555
Office Version
  1. 2019
  2. 2016
Platform
  1. Windows
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
 

dmt32

Well-known Member
Joined
Jul 3, 2012
Messages
6,833
Office Version
  1. 2019
Platform
  1. Windows

ADVERTISEMENT

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
 

maabadi

Well-known Member
Joined
Oct 22, 2012
Messages
2,555
Office Version
  1. 2019
  2. 2016
Platform
  1. Windows
You're Welcome & Thanks for Feedback.
 

Forum statistics

Threads
1,143,638
Messages
5,719,977
Members
422,253
Latest member
frankie2016tata

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
Top