MY WORKSHEET change code creates freeze bug after autofilter sort cancel worksheet change code upon filtering possible?

[oldmanwilly]

Hi

Is there a way to abort my worksheet change code if i select an auto filter button drop down/if i sort data via the autofilter button sort option then turn it on?

In my worksheet when you try to sort using the autofilter filter button, it sorts the data fine but then you can't click anything excel the minimise or close button.

The spreadsheet has a large change code where if you click either:
cell containing "peaches" adds a copy of the selected cells row, cell containing "apples" adds a copy of the selected cells row, cell containing "chocolate" adds a copy of the selected cells row, if you click any cell in row b it highlights the entire row of that selected cell.

The spreadsheet is locked, the auto filter has only one visible dropdown in column B(I made the other drop downs invisible.

I am working with sensitive data so would prefer not to send the sheet but I can alter it so the sensitive stuff is hidden if you require this. I searched the internet and found a few articles suggesting it is a bug in excel and that before change events don't exist? i.e I can't say before you filter occurs don't run this macro!

It is definitely my macro that is causing the problem as i deleted it and the spreadsheet didn't freeze.

I thought it was because when you filter it selects all three cells at the same time, so it tried to add some code to say if you select all three then exit sub but that didn't work.

Here is my code its long and very nooby but it works for the purpose (atm) and any and all negative positive feedback appreciated as this is a big job for me.

Thanks in advance if you need anymore information please let me know

Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Application.ScreenUpdating = False
Dim Answer1 As Integer
On Error Resume Next
'this exits the sub if more than one cell is selected
    If Target.Cells.Count > 1 Then
        Exit Sub
    Else
        If Target.Cells.Count = 1 Then
'if only one cell is selected then if its in column b the entire row is selected
            If Target.Column = 2 Then
                Target.EntireRow.Select
            Else
'if the cell is column d and is metric 18a then msgbox will pop up
                If Target.Column = 4 And Target.Value = "peaches" Then
                    Answer1 = MsgBox("To add a new row for this Metric click yes, to stop adding rows Click No?", vbYesNo, "Add new Row")
'if they click yes then a new row matching the row above will be inserted below with a new code
                        If Answer1 = vbYes Then
                            ActiveSheet.Unprotect "TC00"
                            ActiveWorkbook.Unprotect "TC00"
                            ActiveSheet.AutoFilterMode = False
                            Target.EntireRow.Select
                            Selection.Copy
                            Target.Offset(1).EntireRow.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                            Target.Offset(1, -3).Select
                            ActiveSheet.AutoFilterMode = False
                            Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks _
                            :=False, Transpose:=False
'Border made to a thin line
                            Range(Target.Offset(1, -2), Target.Offset(1, 20)).Select
                                With Selection.Borders(xlEdgeTop)
                                    .LineStyle = xlContinuous
                                    .ColorIndex = 0
                                    .TintAndShade = 0
                                    .Weight = xlThin
                                End With
                            Target.Offset(1, -1).Select
                            Selection.Value = Target.Offset(1, -1).Value & "1"
'readds the filter onto the sheet and only shows the filter button in column b
    Dim c As Range
    Dim i As Integer
Application.ScreenUpdating = False
    ActiveSheet.Range("$A$6:$s$3000").AutoFilter Field:=1, Criteria1:=Sheets("sTART").Range("b12"), Visibledropdown:=False
        i = Cells(6, 2).End(xlToRight).Column
            For Each c In Range(Cells(6, 2), Cells(6, 19))
                If c.Column <> 2 Then
                    c.AutoFilter Field:=c.Column, _
                    Visibledropdown:=False
                 End If
            Next c
'THIS IS THE END OF THAT MACRO
                              Target.Offset(1).Select
                              Application.CutCopyMode = False
                              ActiveSheet.Protect "TC00"
                              ActiveWorkbook.Protect "TC00"
                              Application.ScreenUpdating = True
                    Exit Sub
            End If
        Else
            End If
        End If
        If Target.Column = 4 And Target.Value = "chocolate" Then
    Answer1 = MsgBox("To add a new row for this Metric click yes, to stop adding rows Click No?", vbYesNo, "Add new Row")
        If Answer1 = vbYes Then
        ActiveSheet.Unprotect "TC00"
           ActiveWorkbook.Unprotect "TC00"
       ActiveSheet.AutoFilterMode = False
    Target.EntireRow.Select
    Selection.Copy
    Target.Offset(1).EntireRow.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Target.Offset(1, -3).Select
    ActiveSheet.AutoFilterMode = False
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
 'Border made to a thin line
Range(Target.Offset(1, -2), Target.Offset(1, 20)).Select
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
        End With
        Target.Offset(1, -1).Select
        Selection.Value = Target.Offset(1, -1).Value & "1"

'readds the filter onto the sheet and only shows the filter button in column b
    ActiveSheet.Range("$A$6:$s$3000").AutoFilter Field:=1, Criteria1:=Sheets("sTART").Range("b12"), Visibledropdown:=False
        i = Cells(6, 2).End(xlToRight).Column
For Each c In Range(Cells(6, 2), Cells(6, 19))
 If c.Column <> 2 Then
  c.AutoFilter Field:=c.Column, _
    Visibledropdown:=False
 End If
Next c
'THIS IS THE END OF THAT MACRO
    Target.Offset(1).Select
    Application.CutCopyMode = False

    ActiveSheet.Protect "TC00"
    ActiveWorkbook.Protect "TC00"
     Application.ScreenUpdating = True
    Exit Sub
    End If
    Else
    End If
    End If

         If Target.Column = 4 And Target.Value = "apples" Then
    Answer1 = MsgBox("To add a new row for this Metric click yes, to stop adding rows Click No?", vbYesNo, "Add new Row")
        If Answer1 = vbYes Then
        ActiveSheet.Unprotect "TC00"
           ActiveWorkbook.Unprotect "TC00"
       ActiveSheet.AutoFilterMode = False
    Target.EntireRow.Select
    Selection.Copy
    Target.Offset(1).EntireRow.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Target.Offset(1, -3).Select
    ActiveSheet.AutoFilterMode = False
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
 'Border made to a thin line
Range(Target.Offset(1, -2), Target.Offset(1, 20)).Select
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
        End With
        Target.Offset(1, -1).Select
        Selection.Value = Target.Offset(1, -1).Value & "1"

'readds the filter onto the sheet and only shows the filter button in column b

    ActiveSheet.Range("$A$6:$s$3000").AutoFilter Field:=1, Criteria1:=Sheets("sTART").Range("b12"), Visibledropdown:=False
        i = Cells(6, 2).End(xlToRight).Column

For Each c In Range(Cells(6, 2), Cells(6, 19))
 If c.Column <> 2 Then
  c.AutoFilter Field:=c.Column, _
    Visibledropdown:=False
 
 End If

Next c

'THIS IS THE END OF THAT MACRO

    Target.Offset(1).Select
    Application.CutCopyMode = False

    ActiveSheet.Protect "TC00"
    ActiveWorkbook.Protect "TC00"
     Application.ScreenUpdating = True
    Exit Sub
    End If
    Else
    End If
    End If
    Application.ScreenUpdating = True
End Sub

 

[bobsan42]

Try to debug - put a breakpoint in the beginning of the code and then follow step-by-step (F8) - try to figure what goes wrong.
Also put a line in the beginning and the end to disable/enable events (Application.EnableEvents) - your code uses Select method which may trigger it again so you enter an "infinite" loop.
Also consider removing the "On Error Resume Next" instruction - at least until you figure the problem - you may be missing something.
Reading the whole code w/o context/data is quite a tedious task

 

[oldmanwilly]

you were right it kept looping because the click code meant it ran it so many times, I changed that specific piece of the worksheet with a double click and now it works thanks