I have two codes depend on application events to run.

Code (1) change color of column_A If FilterMode is True on any column of ActiveSheet.

Code (2) Log changes of any cells in ActiveSheet and put in another sheet("Log").

Error raised if : Filtermode = False and any cells changed by fill handle (the small square in the lower-right corner of the selected cell) , I got this error

Method 'Undo' of object '_Application' failed

on this line Application.Undo on Code (2). I tried to use to disable and enable events with code (1) with no luck.

any help will be appreciated.

Option Compare Text

Private Sub worksheet_SelectionChange(ByVal Target As Excel.Range)

'Code (1) change color of column_A If FilterMode is True on any column of active sheet.

    Dim Column_A As Range
    
     Set Column_A = ActiveSheet.Range("A3", ActiveSheet.Range("A" & ActiveSheet.Rows.count).End(xlUp))
    
     If ActiveSheet.FilterMode = True Then
        Column_A.Interior.Color = RGB(196, 240, 255)
        Else  'FilterMode = False
        Column_A.Interior.Color = RGB(255, 255, 255)
     End If
     
    End Sub
    
    ' Code (2) Log Changes of Current Sheet and put in Sheet("Log")
    
    Private Sub Worksheet_Change(ByVal Target As Range)
    
     Dim RangeValues As Variant, r As Long, boolOne As Boolean, TgValue
     Dim sh As Worksheet: Set sh = Sheets("Log")
     Dim UN As String: UN = Environ$("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
         Application.Undo
         RangeValues = extractData(Target)          'Define RangeValue
         putDataBack TgValue, ActiveSheet           'Reinsert changed data
         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))
               'Array("User Name", "Date,Time", "Work Order", "Column Label", "New Value", "Old Value")
               
            Range(RangeValues(r)(1)).EntireRow.AutoFit
            If Range(RangeValues(r)(1)).RowHeight < 53 Then
               Range(RangeValues(r)(1)).RowHeight = 53
            End If
        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

CodePudding user response：

I figured out the issue, although the error rising with code (2) Worksheet_Change event ,

But actually SelectionChange event on code(1) is the real problem.

Apparently, when I drag down, it is sort of like selecting cells individually and all of them at the same time.

To solve this issue, a condition must be added to event SelectionChange to count the target cells:

If Target.Cells.CountLarge = 1 then

So I just modified the code to look like this in the SelectionChange part and it now works perfectly.

'Code (1)
Private Sub worksheet_SelectionChange(ByVal Target As Excel.Range)

 If Target.Cells.CountLarge = 1 Then

 Dim Column_A As Range

 Set Column_A = ActiveSheet.Range("A3", ActiveSheet.Range("A" & ActiveSheet.Rows.count).End(xlUp))

 If ActiveSheet.FilterMode = True Then
    Column_A.Interior.Color = RGB(255, 0, 0)
    Else  'FilterMode = False
    Column_A.Interior.Color = RGB(255, 255, 255)
   End If
  End If
End Sub

In the meantime, I learned that Calculate event would be best choice to trapping a change to a filtered list as described on this link

https://www.experts-exchange.com/articles/2773/Trapping-a-change-to-a-filtered-list-with-VBA.html