In VBA, which relates to the ability to sort/autofilter?

T

TheJay

Active Member
Joined
Nov 12, 2014
Messages
364
Office Version
  1. 2019
Platform
  1. Windows
I am using the following code:

VBA Code: 
Option Explicit

Private Sub Worksheet_Activate()
    Range("C4").Select
    With Worksheets("VO Areas")
    With ActiveWindow
        .DisplayFormulas = False
        .DisplayHeadings = False
        .DisplayGridlines = False
        .DisplayHorizontalScrollBar = False
        .DisplayVerticalScrollBar = False
    End With
    With Application
        .DisplayFullScreen = True
        .DisplayFormulaBar = False
        .DisplayStatusBar = False
    End With
    With Application
        .CommandBars("Full Screen").Visible = True
        .CommandBars("Worksheet Menu Bar").Enabled = False
        .CommandBars("Standard").Visible = False
        .CommandBars("Formatting").Visible = False
    End With
End With
End Sub

I have three columns that I want to be able to use the dropdown list on to be able to sort. If I define a range to allow users to edit, they can change the text in the headings but it does not allow the dropdown lists to be used. If I unprotect the worksheet and then lock it again with "Allow all users of this workbook to:" and tick "Sort" and "Use AutoFilter", it works. I save and it works. Then, I close and open the file again and the ability is lost and the options have been unticked.

Can someone please tell me how I can stop these options being disabled?
 

Excel Facts

Best way to learn Power Query?
Read M is for (Data) Monkey book by Ken Puls and Miguel Escobar. It is the complete guide to Power Query.
Sort by date Sort by votes
I believe the issue is code in ThisWorkbook:

VBA Code: 
Private Sub Workbook_Open()
Dim Sh          As Worksheet
    For Each Sh In Worksheets
        Sh.Protect UserInterFaceOnly:=True
    Next
End Sub

How do I add an exception to either allow sorting and autofilter to work on the sheet "VO Areas", allow sorting and autofilter on C171-E171 or is there another option that will work just as well or better?

Thanks for your help.
 
Upvote 0
How about changing your Workbook_Open code to this:
VBA Code: 
Private Sub Workbook_Open()
    Dim Sh          As Worksheet
    For Each Sh In Worksheets
        If Sh.Name = "VO Areas" Then
            Sh.Protect UserInterFaceOnly:=True, AllowSorting:=True, AllowFiltering:=True
        Else
            Sh.Protect UserInterFaceOnly:=True
        End If
    Next
End Sub

The sorting seems a bit tricky though. All the cells in the sort range need to be unlocked which seems an unlikely scenario.
 
Upvote 0
Solution
Thank you, that definitely unlocks the functionality. AWESOME!
 
Last edited:
Upvote 0
Could you please tell me how I would define multiple sheets that it should be possible to autosort/filter on or if the list is long, have it work to define those that should not be autosorted/filtered?
 
Upvote 0
Just convert the if statement to a Select Case.
See which is going to be less maintenance for you to ie whether you lists the ones you want to include or those you want to exclude.

VBA Code: 
    Dim Sh          As Worksheet
    
    For Each Sh In Worksheets
    
        Select Case Sh.Name
            Case "VO Areas", "Protect 2"
                Sh.Protect UserInterFaceOnly:=True, AllowSorting:=True, AllowFiltering:=True
            Case Else
                Sh.Protect UserInterFaceOnly:=True
        End Select
        
    Next
 
Upvote 0
Thank you.

Now I have a problem with the other code that needs incorporating with the above. I have a search page and it produces a list of search results from all the other spreadsheets in the worksheet, along with a hyperlink in the left hand column of each result. I want everything protected from being copies/pasted except for the hyperlink in the first column. So, I formatting all cells except the first column and protected them, then the code locks the sheet.

Part of the reason for this is because one of the columns has an email address in it and clicking on it causes a debug error and it stops all macros working unless all workbooks are closed and reopened.

VBA Code: 
Option Explicit

Private mPrevSheet As Worksheet
'Reset the search page and show only these worksheets
Private Sub Workbook_Open()

    With ActiveWindow
        .DisplayFormulas = False
        .DisplayHeadings = False
        .DisplayGridlines = False
        .DisplayHorizontalScrollBar = False
        .DisplayVerticalScrollBar = False
    End With
    
    With Application
        .DisplayFullScreen = True
        .DisplayFormulaBar = False
        .DisplayStatusBar = False
        .CommandBars("Full Screen").Visible = True
        .CommandBars("Worksheet Menu Bar").Enabled = False
        .CommandBars("Standard").Visible = False
        .CommandBars("Formatting").Visible = False
    End With

    Dim sht As Worksheet

    With Worksheets("Search")
        .Pictures.Delete
        .Range("A1").Clear
        .Range("A3:H500").Clear
        With .Range("A3:A500")
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
        End With
    End With
    
    Worksheets("Search").Activate
'    Worksheets("Contents").Activate
      
End Sub

I think I need this code to unlock the sheet, execute and then lock it after finishing?

The error comes at this point at the moment:

Code: 
    With Worksheets("Search")

        .Pictures.Delete

        .Range("A1").Clear

        .Range("A3:H500").Clear

        With .Range("A3:A500")

            .HorizontalAlignment = xlCenter

            .VerticalAlignment = xlCenter

        End With

    End With
 
Upvote 0
Trying to incorporate the code you proposed brings up an error because the sheet is protected. When it's not protected, it comes up with VB Error 400. This is all code in ThisWorkbook.

Code: 
Option Explicit

Private mPrevSheet As Worksheet
'Reset the search page and show only these worksheets
Private Sub Workbook_Open()

    With ActiveWindow
        .DisplayFormulas = False
        .DisplayHeadings = False
        .DisplayGridlines = False
        .DisplayHorizontalScrollBar = False
        .DisplayVerticalScrollBar = False
    End With
  
    With Application
        .DisplayFullScreen = True
        .DisplayFormulaBar = False
        .DisplayStatusBar = False
        .CommandBars("Full Screen").Visible = True
        .CommandBars("Worksheet Menu Bar").Enabled = False
        .CommandBars("Standard").Visible = False
        .CommandBars("Formatting").Visible = False
    End With

    Dim sht As Worksheet

    With Worksheets("Search")
        .Pictures.Delete
        .Range("A1").Clear
        .Range("A3:H500").Clear
        With .Range("A3:A500")
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
        End With
    End With
  
    Worksheets("Search").Activate
'    Worksheets("Contents").Activate

    Dim Sh          As Worksheet
  
    For Each Sh In Worksheets
  
        Select Case Sh.Name
            Case "Cs", "LCs", "Ls", "HAs", "LSA", "Ss", "Es"
                Sh.Protect UserInterFaceOnly:=True, AllowSorting:=True, AllowFiltering:=True
            Case Else
                Sh.Protect UserInterFaceOnly:=True
        End Select
      
    Next
      
End Sub

Code that operates the search sheet:

Code: 
Option Explicit

Private Sub Worksheet_Activate()
    Range("A1").Select
    With Worksheets("Search")
    With ActiveWindow
        .DisplayFormulas = False
        .DisplayHeadings = False
        .DisplayGridlines = False
        .DisplayHorizontalScrollBar = True
        .DisplayVerticalScrollBar = True
    End With
    With Application
        .DisplayFullScreen = True
        .DisplayFormulaBar = False
        .DisplayStatusBar = False
    End With
    With Application
           .CommandBars("Full Screen").Visible = True
        .CommandBars("Worksheet Menu Bar").Enabled = False
        .CommandBars("Standard").Visible = False
        .CommandBars("Formatting").Visible = False
    End With
End With
End Sub

Sub Set_Search()
Call Reset1
    Dim wks As Excel.Worksheet
    Dim rCell As Excel.Range
    Dim fFirst As String
    Dim n As Long
    Dim MyVal As String
    MyVal = InputBox("Enter the full name of an individual, department, organisation or area that you wish to contact.", "Contact Search", "")
    If MyVal = "" Then Exit Sub
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    With Cells(1, 1)
        .Value = "Found '" & MyVal & "' in the following cells:" & vbCrLf & "(click below to view the original data)"
        .EntireColumn.AutoFit
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        With Selection.Font
             .Name = "Arial"
             .FontStyle = "Regular"
             .Size = 10
        End With
    End With
    n = 3
    Dim a, i As Long, ii As Long, rng As Range, x As Range, LastR As Range
    Set LastR = Cells(3, 2)
    For Each wks In ActiveWorkbook.Worksheets
         If (wks.Name <> "Search") And (wks.Name <> "Contents") And (wks.Name <> "Help") Then
            Set rng = Intersect(wks.Range("A:L"), wks.UsedRange)
            a = rng.Value
            If IsArray(a) Then
                For i = 1 To UBound(a, 1)
                    For ii = 1 To UBound(a, 2)
                        If UCase$(CStr(a(i, ii))) Like "*" & UCase$(MyVal) & "*" Then
                            rng.Cells(i, ii).Hyperlinks.Add Cells(n, 1), "", "'" & _
                                wks.Name & "'!" & rng.Cells(i, ii).Address
                            If x Is Nothing Then
                                Set x = wks.Rows(i).Range("a1:k1")
                            Else
                                Set x = Union(x, wks.Rows(i).Range("a1:k1"))
                            End If
                            n = n + 1: Exit For
                        End If
                    Next
                Next
                If Not x Is Nothing Then
                    x.Copy LastR: Set x = Nothing
                    Set LastR = Cells(Rows.Count, 1).End(xlUp)(2, 2)
                End If
            End If
         End If
    Next wks
    If n = 3 Then
        MsgBox "No results containing your search term were found." & vbCrLf & "" & vbCrLf & "Your search for '" & MyVal & "' did not match any exising data." & vbCrLf & "" & vbCrLf & "These contact details will be added.", 64, "Contact Search"
        Cells(1, 1).Value = ""
    End If
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
    Dim wsName As String
    Application.EnableEvents = False
    If InStr(1, Target.Parent, "!") Then
        wsName = Left$(Target.Parent, InStr(Target.Parent, "!") - 1)
        If wsName Like "*'" Then wsName = Left$(wsName, Len(wsName) - 1)
    Else
        wsName = Target.Parent.Name
    End If
    Sheets(wsName).Visible = -1
    Sheets(wsName).Activate
    Application.EnableEvents = True
End Sub
 
Upvote 0
Previously added code to stop errors showing when the email addresses are clicked (debut comes up and it stops the macros from working as described above), but I'd rather stop them being clicked in the first place or make them work without bringing up an error:

Also in ThisWorkbook:

Code: 
'Stop errors from appearing when links clicked on particular worksheets
Private Sub Workbook_SheetFollowHyperlink(ByVal Sh As Object, ByVal Target As Hyperlink)

    If Sh.Name = "Contents" Or Sh.Name = "Search" Then
        If Not mPrevSheet Is Nothing Then
            mPrevSheet.Visible = xlSheetHidden
        End If
        If Len(Target.Address) = 0 Then
            Set mPrevSheet = Range(Target.SubAddress).Parent
            If Not mPrevSheet Is Nothing Then
                mPrevSheet.Visible = xlSheetVisible
                Application.Goto mPrevSheet.Range(Target.SubAddress), False
            End If
        End If
    End If
    
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

T
  • Solved
Hiding menu items in specified sheets
Replies
2
Views
523
TheJay
T
T
  • Question
VBA code not working, have a sheet that copies contents of any unlocked cell to clipboard and want to change tab order
Replies
5
Views
620
TheJay
T
K
  • Question
VBA code asking for Macro
Replies
9
Views
574
KMH
K
T
  • Solved
Why is selecting a cell in VBA throwing an error and how to fix?
2
Replies
11
Views
767
Alex Blakenburg
A
T
  • Solved
Shortening/combining VBA
2
Replies
10
Views
677
Joe4
Joe4

Forum statistics

Threads
1,215,461
Messages
6,124,955
Members
449,200
Latest member
indiansth

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top