Autofilter and Worksheet_Change

[darrylburge]

I have a workbook with the following code:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rngMonitor  As Range
    Dim rng         As Range

    Set rngMonitor = Intersect(Range("A6:A199"), Target)

    If Not rngMonitor Is Nothing Then
        Application.EnableEvents = False
        MsgBox "Please do not change the data in column A", vbExclamation
        Application.Undo
        Application.EnableEvents = True
        Exit Sub
    End If


    Set rngMonitor = Intersect(Range("B6:B199"), Target)

    If Not rngMonitor Is Nothing Then
        Call AutoFilter_Example1
    End If

End Sub


Sub AutoFilter_Example1()
    Dim i           As Long

    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False

    With ActiveSheet
        If .AutoFilterMode Then
            .AutoFilterMode = False
        End If

        With .Range("A5:I" & Cells(Rows.Count, "A").End(xlUp).Row)
            For i = 1 To .Columns.Count
                .AutoFilter Field:=i, VisibleDropDown:=False
            Next i
            .AutoFilter Field:=1, Criteria1:="<>Hide"
            .AutoFilter Field:=9, Criteria1:=""
        End With
    End With

    Application.Calculation = xlCalculationAutomatic

End Sub

My issue is that I cannot enter anything into Column A, and I am also unable to complete tasks such as Centre/Merge a row if it includes column A. Is there any way of making it so the code is not so vociferous? My only other alternative might be to remove the code, and use a standard Filter which will need to be reapplied, however I was hoping to not have to do this manually.

The other code I have, but is not causing any of the issue is:
ThisWorkbook

Private Sub Workbook_SheetCalculate(ByVal sh As Object)
    If sh.Name = ActiveSheet.Name Then
        If Range("E200") = "Yes" Or Range("G200") > 4 Then
            If sh.Tab.Color <> RGB(255, 0, 0) Then    ' Red
                sh.Tab.Color = RGB(255, 0, 0)
            End If
        Else
            If sh.Tab.Color <> RGB(146, 208, 80) Then
                sh.Tab.Color = RGB(146, 208, 80)    ' Light Green
            End If
        End If
    End If
End Sub

and

Module1

Sub Sort_Tabs_Alphabetically()

    For i = 1 To Application.Sheets.Count
        For j = 1 To Application.Sheets.Count - 1
            If UCase$(Application.Sheets(j).Name) > UCase$(Application.Sheets(j + 1).Name) Then
                Sheets(j).Move After:=Sheets(j + 1)
            End If
        Next
    Next

    MsgBox "The tabs have been sorted from A to Z."

End Sub





Sub Add_New_Staff()
    Worksheets("2nd Sheet").Copy After:=Worksheets(Worksheets.Count)
    Worksheets(Worksheets.Count).Name = InputBox("New Staff Name (Last First):")
    
End Sub

 

[Joe4]

Welcome to the Board!

A few things...

The reason why you cannot update column A is because this section of your code is explicitly preventing it:

    Set rngMonitor = Intersect(Range("A6:A199"), Target)

    If Not rngMonitor Is Nothing Then
        Application.EnableEvents = False
        MsgBox "Please do not change the data in column A", vbExclamation
        Application.Undo
        Application.EnableEvents = True
        Exit Sub
    End If

If you want the ability to update column A, then remove this whole section of code.

Secondly, if you are trying to do filtering, I STRONGLY advise you NOT to use Merged Cells!
Merged Cells are just about the worst feature of Excel, and cause nothing but issues, especially with things like VBA, filtering and sorting.
Most serious programmers will avoid Merged Cells at all costs, and I advise you to do the same.

If you are simply trying to merge multiple columns within single rows, it is MUCH better to use the "Center Across Selection" formatting feature instead, which will give you the same visual effect as Merged Cells without all the issues they cause. See: Tom’s Tutorials For Excel: Using Center Across Selection Instead of Merging Cells – Tom Urtis

 

[darrylburge]

Thank you for the change in code. That has made the worksheets much more user-friendly.

And i will bear in mind the advice regarding "Centre Across"

 

[Joe4]

You are welcome.
Glad I was able to help!