VBA Private Sub; posting question...

[Pinaceous]

Good Afternoon,

I have a Private Sub that I have posted onto Sheet1 (Sheet1) that works great on its tab.

Now, if I wanted to have this Private Sub to work on every sheet of the workbook, I thought I would post it onto ThisWorkbook but it does not work upon every sheet of the workbook.

Do I have to change the Private Sub in any way?

This is the code below, in case you need to reference it:

[COLOR=#222222][FONT=Verdana]Private Sub Worksheet_Change(ByVal Target As Range)[/FONT][/COLOR]

[COLOR=#222222][FONT=Verdana]    Dim CurrRangeAs String[/FONT][/COLOR]
[COLOR=#222222][FONT=Verdana]    Dim CurrVal AsVariant[/FONT][/COLOR]
[COLOR=#222222][FONT=Verdana]    Dim found AsBoolean[/FONT][/COLOR]
[COLOR=#222222][FONT=Verdana]    Dim x AsVariant, d As Variant[/FONT][/COLOR]
[COLOR=#222222][FONT=Verdana]    Dim c As Range,r As Range[/FONT][/COLOR]
[COLOR=#222222][FONT=Verdana]    Dim cell AsRange[/FONT][/COLOR]
[COLOR=#222222][FONT=Verdana]    Dim dateRng AsDate[/FONT][/COLOR]
[COLOR=#222222][FONT=Verdana]    Dim sDate1 AsDate[/FONT][/COLOR]
[COLOR=#222222][FONT=Verdana]    Dim sDate2 AsDate[/FONT][/COLOR]
[COLOR=#222222][FONT=Verdana]    sDate1 =#10/1/2019#[/FONT][/COLOR]
[COLOR=#222222][FONT=Verdana]    sDate2 =#9/30/2020#[/FONT][/COLOR]



[COLOR=#222222][FONT=Verdana]If Not Intersect(Target, Range("B8:B66")) IsNothing Then[/FONT][/COLOR]
[COLOR=#222222][FONT=Verdana]    Set Target =Range("B" & ActiveCell.Row - 1)[/FONT][/COLOR]
[COLOR=#222222][FONT=Verdana]    If Target<> Empty Then[/FONT][/COLOR]
[COLOR=#222222][FONT=Verdana]        CurrRow =Target.Row[/FONT][/COLOR]
[COLOR=#222222][FONT=Verdana]        CurrVal =Cells(Target.Row, "B").Value[/FONT][/COLOR]
[COLOR=#222222][FONT=Verdana]        If CurrVal< sDate1 Or CurrVal > sDate2 Then[/FONT][/COLOR]
[COLOR=#222222][FONT=Verdana]           Range("B" & CurrRow).Select[/FONT][/COLOR]
[COLOR=#222222][FONT=Verdana]            MsgBox"The Date you Entered: - " & CurrVal & vbCrLf _[/FONT][/COLOR]
[COLOR=#222222][FONT=Verdana]            &"is outside of acceptable date range of 10/1/2019 to 9/30/2020" &vbCrLf & vbCrLf _[/FONT][/COLOR]
[COLOR=#222222][FONT=Verdana]            &"Please correct Date to an acceptable value.", vbOKOnly[/FONT][/COLOR]
[COLOR=#222222][FONT=Verdana]        End If[/FONT][/COLOR]
[COLOR=#222222][FONT=Verdana]    End If[/FONT][/COLOR]
[COLOR=#222222][FONT=Verdana]End If[/FONT][/COLOR]



[COLOR=#222222][FONT=Verdana]End Sub[/FONT][/COLOR]

Many thanks in advance!

Pinaceous J

 

[Paul Ked]

The Worksheet_Change event is sheet specific so it has to be in the sheet code module. You could have a common sub in a normal code module which each sheet event can call.

 

[Pinaceous]

The Worksheet_Change event is sheet specific so it has to be in the sheet code module. You could have a common sub in a normal code module which each sheet event can call.

Do you mean like apply it in a normal module?

Thank you for your posting!

 

[Paul Ked]

If you have Worksheet_Change (or any of the other procedure in the Worksheet object) event, it only detects changes on that sheet.

If you wanted to do the same thing on multiple sheets you could call a sub in a code module.

For example: if every time you double-clicked any sheet you wanted a warning you could put

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Warning
End Sub

in every Worksheet module and

Sub Warning()
    MsgBox "Warning, double-click!", vbExclamation, "Oops!"
End Sub

in a normal module (eg Module1)

 

[DanteAmor]

Now, if I wanted to have this Private Sub to work on every sheet of the workbook, I thought I would post it onto ThisWorkbook but it does not work upon every sheet of the workbook.

How does it not work on all sheets?

It works, but in this even in Thisworkbook

Private Sub [COLOR=#0000ff]Workbook_SheetChange[/COLOR](ByVal Sh As Object, ByVal Target As Range)
  Dim CurrRange As String
  Dim CurrVal As Variant
  Dim found As Boolean
  Dim x As Variant, d As Variant
  Dim c As Range, r As Range
  Dim cell As Range
  Dim dateRng As Date
  Dim sDate1 As Date
  Dim sDate2 As Date
  sDate1 = #10/1/2019#
  sDate2 = #9/30/2020#


  If Not Intersect(Target, Range("B8:B66")) Is Nothing Then
      Set Target = Range("B" & ActiveCell.Row - 1)
      If Target <> Empty Then
          CurrRow = Target.Row
          CurrVal = Cells(Target.Row, "B").Value
          If CurrVal < sDate1 Or CurrVal > sDate2 Then
             Range("B" & CurrRow).Select
              MsgBox "The Date you Entered: - " & CurrVal & vbCrLf _
              & "is outside of acceptable date range of 10/1/2019 to 9/30/2020" & vbCrLf & vbCrLf _
              & "Please correct Date to an acceptable value.", vbOKOnly
          End If
      End If
  End If
End Sub

 

[MARK858]

@Pinaceous, If you want to run code from ThisWorkbook then it needs to be Workbook event code not Worksheet event code but there are various worksheet specific options amongst the Workbook event codes including

Private Sub Workbook_SheetActivate(ByVal Sh As Object)

End Sub

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)

End Sub

Private Sub Workbook_SheetCalculate(ByVal Sh As Object)

End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)

End Sub

See the link below
https://docs.microsoft.com/en-us/office/vba/api/excel.workbook#events


Edit:

How does it not work on all sheets?

Because the OP was using Worksheet_Change not Workbook_SheetChange when they posted in ThisWorkbook

 

[DanteAmor]

Because the OP was using Worksheet_Change not Workbook_SheetChange when they posted in ThisWorkbook

I assumed that too, that's why I put the code inside the event Workbook_SheetChange, But I want OP confirmation, maybe OP needs something else.

 

[Pinaceous]

DanteAmor,

I’ve tried your code and it works great!

Thank you for posting!
Paul

 

[DanteAmor]

DanteAmor,

I’ve tried your code and it works great!

Thank you for posting!
Paul

Hi @Pinaceous, Im glad to help you, thanks for the feedback.