Home > Software design >  Target cells not triggered by event `Worksheet_Change`. How to fix?
Target cells not triggered by event `Worksheet_Change`. How to fix?

Time:12-26

I am using below codes as the following:
Code(1)@ Worksheet_SelectionChange Insert Date by using Date Picker(calendar) on sheet "North" Column M.
Code(2) @ Worksheet_Change of sheet North to Log changes of any cells and put in sheet("Log").
Code(3) in a separate module "Calendar" to initiate calendar

the codes works except in one condition
Target cells not triggered by event Worksheet_Change
to produce issue use calendar to enter any value but not click outside Column M then delete these values again , then switch to sheet "Log" you will notice that there are no entries for deleted values at all.
As always: any help will be appreciated.
(Link for the real file found in first comment)

Option Explicit
Option Compare Text

Private Sub worksheet_SelectionChange(ByVal Target As Excel.Range)
  If Not Intersect(Target, Range("M3:M100")) Is Nothing Then
        Call Basic_Calendar
  Else
        boolDate = False 'make it false to trigger the previous behavior in Worksheet_Change event
  End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)   'Log Changes of Current Sheet and put in Sheet("Log")
 Dim RangeValues As Variant, r As Long, boolOne As Boolean, TgValue  'the array to keep Target values (before UnDo)
 Dim SH As Worksheet: Set SH = Sheets("Log")
 Dim UN As String: UN = Application.UserName
 
 If Not Intersect(Target, Range("AK:XFD")) Is Nothing Then Exit Sub  'not doing anything if a cell in AK:XFD is changed
 
 Application.ScreenUpdating = False
 Application.Calculation = xlCalculationManual
 
 If Target.Cells.Count > 1 Then
    TgValue = ExtractData(Target)
 Else
    TgValue = Array(Array(Target.value, Target.Address(0, 0)))  'Put the target range in an array (or as a string for a single cell)
    boolOne = True
 End If
 
 Application.EnableEvents = False               'Avoide trigger the change event after UnDo
     If boolDate Then  '____________________________________________________________
        Dim prevTarget
        prevTarget = Target.value                'memorize the target value
        Target.value = PrevVal                     'change the target value to the one before changing
        RangeValues = ExtractData(Target)    'extract data exactly as before
        Target.value = prevTarget                'set the last date
     Else                   '____________________________________________________________
        Application.Undo
        RangeValues = ExtractData(Target)          'Define RangeValue
        PutDataBack TgValue, ActiveSheet           'Put back the changed data
     End If
     
     If boolOne Then Target.Offset(1).Select
 Application.EnableEvents = True

 Dim columnHeader As String, rowHeader As String
 
 For r = 0 To UBound(RangeValues)
    If RangeValues(r)(0) <> TgValue(r)(0) Then
        columnHeader = Cells(1, Range(RangeValues(r)(1)).Column).value
        rowHeader = Range("B" & Range(RangeValues(r)(1)).Row).value
        
        Sheets("Log").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Resize(1, 6).value = _
            Array(UN, Now, rowHeader, columnHeader, TgValue(r)(0), RangeValues(r)(0))
    End If
 Next r
 
  Application.ScreenUpdating = True
  Application.Calculation = xlCalculationAutomatic
          
 End Sub

Sub PutDataBack(arr, SH As Worksheet)
    Dim i As Long, arrInt, El
    For Each El In arr
        SH.Range(El(1)).value = El(0)
    Next
End Sub
Function ExtractData(Rng As Range) As Variant
    Dim a As Range, arr, Count As Long, i As Long
    ReDim arr(Rng.Cells.Count - 1)
    For Each a In Rng.Areas 'creating a jagged array containing the values and the cells address
            For i = 1 To a.Cells.Count
                arr(Count) = Array(a.Cells(i).value, a.Cells(i).Address(0, 0)): Count = Count   1
            Next
      Next
    ExtractData = arr
End Function

' in a separate module "Calendar" to initiate calendar Option Explicit Option Compare Text

Public PrevVal As Variant, boolDate As Boolean
Sub Basic_Calendar()
    Dim datevariable As Variant
    datevariable = CalendarForm.GetDate
    If datevariable <> 0 Then
        PrevVal = Selection.value: boolDate = True
        Selection.value = datevariable
    End If
End Sub

CodePudding user response:

In order to make the solution allowing multiple cells entry from the Callendar, but also allowing multiple deletions, please adapt it in the next way:

  1. Use this modified code in the module where Basic_Calendar Sub exists:
Option Explicit
Option Compare Text

Public PrevVal(), boolDate As Boolean
Sub Basic_Calendar()
    Dim datevariable As Variant
    datevariable = CalendarForm.GetDate
    If datevariable <> 0 Then
        PrevVal = Selection.value: boolDate = True
        Selection.value = datevariable
    Else
        Erase PrevVal 'to identify the case of deletion        
    End If
End Sub
  1. Adapt this part of the Worksheet_Change event code in the next way:
If Target.Cells.Count > 1 Then
    If Not CBool(Not Not PrevVal) Then boolDate = False 'the new line checking if the multiple rows array is empty (or not)
    TgValue = ExtractData(Target)
 Else
    TgValue = Array(Array(Target.value, Target.Address(0, 0)))  'Put the target range in an array (or as a string for a single cell)
    boolOne = True
 End If

The logic of the modification works as following:

a. When the Calendar form is called and it returns a Date, in a multi rows range, the delivered datevariable is dropped in the selected cells, and their previous value are loaded in PrevVal() array;

b. A change in Column "M:M" triggers the event and in case of PrevVal() not empty, it acts as usually for inserting Data (using the PrevVal() array elements instead of UnDo, which does not work for data added by code). In case of an empty array, it makes boolDate = False, switching the code to the clasic variant (able to use UnDo, because deletion has been done by the user)...

No need to check the code on another PC. It was a matter of solution logic starting from a wrong assumption and it cannot work differently than on your laptop.

  • Related