VBA auto sort multicolumn table when data is changed or deleted in protected sheet mode

[Roumen Roussev]

I use the code to automatically sort the table by attribute "Name" from column B.


Private Sub Worksheet_Change(ByVal Target As Excel.Range)
On Error Resume Next
If Not Intersect(Target, Range("A:Z")) Is Nothing Then
Range("B5").Sort Key1:=Range("B6"), _
Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End Sub


The first problem with this code is that when I delete a record after the first line remains an empty cell.
The second problem is how to make the code work while sheet is password-protected.
Protected password can be found in sheet PASS.

This is the WeTransfer link to an Excel file: https://we.tl/t-00zqVQgx82

 

[sijpie]

Hi Roussev,

a couple of problems with your code.
First is the line

On Error Resume Next

You need a reason to use this. Normally I will use it when I test some variable, for instance to check if a workbook object is set to a workbook or not. Else Excel would show a message on the screen and a user cannot do anything with that. But after I have tested the variable, I will reset the errorchecking to default using

On Error goto 0

for instance:

Sub OpenFile(sFileName As String)
    Dim wbF As Workbook
    
    On Error Resume Next    'continue if error,
    Set wbF = Workbooks.Open(Filename:=sFileName)
    On Error GoTo 0
    If wbF Is Nothing Then ' File not found
        MsgBox "Could not find file " & sFileName
        Exit Sub
    End If
    'rest of code
        
End Sub

If you don't reset the error handling, you can get very problematic bugs. But you won't know where the error occured!

The second, as you mention, is that you have issues sorting when the user deletes a value or so.
I will always give my range to be sorted a range name.
And before I do the sort I will check what type of change the user made. If an item was deleted, or added I will adjust the range first, then do the sort.

Private Sub Worksheet_Change(ByVal Target As Range)
    Const PW As String = "MyPaSsWoRd"
    
    If Not Intersect(Target, Range("A:Z")) Is Nothing Then
        Application.EnableEvents = False 'Because I might be making changes _
                                          I dont want this to loop
        Me.Unprotect Password:=PW
    
        AdjustRange "MySortRange"
        Me.Protect Password:=PW, AllowSorting:=True, contents:=True
        Application.EnableEvents = True  'reset!!
    End If
End Sub

Sub AdjustRange(sName As String)
    Dim rR As Range, lRw As Long
    
    Set rR = Range(sName)
    'check to see if user deleted cell contents, if so delete row
    If IsEmpty(ActiveCell) Then rR.Rows(ActiveCell.Row).Delete (xlUp)
    'get the new range size
    lRw = rR(1, 1).End(xlDown).Row - rR.Row + 1
    ' and reset range name to new size
    rR(1, 1).Resize(lRw, 1).Name = sName
    ' now sort
    Range(sName).Sort Key1:=Range(sName)
    Set rR = Nothing
End Sub

Also Roussev, next time use code tags around your code (see below in my tagline how to do this). Your code will come out nicely in a box, with indentation. Some people on this forum will not answer posts without code tags.

 

[Roumen Roussev]

Thank you for your help and understanding sijpie. I tried to correct my post and put codetags around the code but no editing is allowed.
As I wrote,I only use the code I found on a website. I'm not familiar with programmingand I don't quite understand your coding. I tried this because I need this kindof functionality. Could you help me by entering the variables in yourcode?
Password:"96541"
Sort keycolumn: B
Sort key: B6
Sort range:A6:Z2000

Private Sub Worksheet_Change(ByVal Target As Range)
    Const PW As String= [COLOR=red]"[/COLOR][COLOR=red]96541[/COLOR][COLOR=red]"[/COLOR]
    
    If NotIntersect(Target, Range("A:Z")) Is Nothing Then
       Application.EnableEvents = False [COLOR=#00b050]'Because Imight be making changes _[/COLOR]
[COLOR=#00b050]                                                              I dont want this to loop[/COLOR]
        Me.UnprotectPassword:=PW    

        AdjustRange"MySortRange"
        Me.ProtectPassword:=PW, AllowSorting:=True, contents:=True
        Application.EnableEvents = True  [COLOR=#00b050]'reset!![/COLOR]
    End If
End Sub 

Sub AdjustRange(sName As String)
    Dim rR As Range,lRw As Long

    Set rR =Range(sName)
[COLOR=#00b050]     'check to see if user deleted cellcontents, if so delete row[/COLOR]
    IfIsEmpty(ActiveCell) Then rR.Rows(ActiveCell.Row).Delete (xlUp)
[COLOR=#00b050]    'get the new range size[/COLOR]
    lRw = rR(1,1).End(xlDown).Row - rR.Row + 1
[COLOR=#00b050]     'and reset range name to new size[/COLOR]
    rR(1,1).Resize(lRw, 1).Name = sName
[COLOR=#00b050]     'now sort[/COLOR]
    Range(sName).SortKey1:=Range(sName)
    Set rR = Nothing
End Sub