VBA Sort Error

Excel_Guy684

New Member
Joined
Aug 13, 2021
Messages
7
Office Version
  1. 365
Platform
  1. Windows
Hi all,

I'm new to Macros and have been trying to set up a macro that groups data, removes filters, sorts data and protects sheets when closing.
All 3 macros work perfectly fine when run on their own but when I close the file and try to run all 3 concurrently it doesn't work with the error 'sub-script out of range' on the sort code in bold.

HELP please.

Rich (BB code):
Sub EstateTracker()
   
 Dim ws As Worksheet
    Dim pwd
    pwd = "jason"
    Set ws = Sheet1
   
    ws.Unprotect Password:=pwd
    If ws.FilterMode Then ws.ShowAllData
    If ws.AutoFilterMode Then ws.AutoFilterMode = False
    ws.Range("A:D").Ungroup
    ws.Range("A:D").Group
    ws.Range("V:AS").Ungroup
    ws.Range("V:AS").Group
    ws.Outline.ShowLevels Columnlevels:=1
    Dim lastrow As Long
    lastrow = Cells(Rows.Count, 2).End(xlUp).Row
    ws.Range("A3:AR" & lastrow).Sort Key1:=Range("G3:G" & lastrow), _
    order1:=xlAscending, Header:=xlYes
    'ws.Protect'
    EnableSelection = xlUnlockedCells
    If ws.ProtectContents = False Then
    ws.Protect Password:=pwd, AllowFiltering:=True
    End If
    ActiveWorkbook.Save
       
End Sub

Sub ServiceEngineers()
   
 Dim ws As Worksheet
    Dim pwd
    pwd = "jason1"
    Set ws = Sheet4
   
    ws.Unprotect Password:=pwd
    If ws.FilterMode Then ws.ShowAllData
    If ws.AutoFilterMode Then ws.AutoFilterMode = False
    ws.Range("A:D").Ungroup
    ws.Range("A:D").Group
    ws.Range("V:AS").Ungroup
    ws.Range("V:AS").Group
    ws.Outline.ShowLevels Columnlevels:=1
    Dim lastrow As Long
    lastrow = Cells(Rows.Count, 2).End(xlUp).Row
    ws.Range("A3:AR" & lastrow).Sort Key1:=Range("G3:G" & lastrow), _
    order1:=xlAscending, Header:=xlYes
    'ws.Protect'
    EnableSelection = xlUnlockedCells
    If ws.ProtectContents = False Then
    ws.Protect Password:=pwd, AllowFiltering:=True
    End If
    ActiveWorkbook.Save
       
End Sub

Sub Cadtechnicians()
   
 Dim ws As Worksheet
    Dim pwd
    pwd = "jason2"
    Set ws = Sheet3
   
    ws.Unprotect Password:=pwd
    If ws.FilterMode Then ws.ShowAllData
    If ws.AutoFilterMode Then ws.AutoFilterMode = False
    ws.Range("A:D").Ungroup
    ws.Range("A:D").Group
    ws.Range("M:AA").Ungroup
    ws.Range("M:AA").Group
    ws.Range("AF:AH").Ungroup
    ws.Range("AF:AH").Group
    ws.Range("AL:AO").Ungroup
    ws.Range("AL:AO").Group
    ws.Outline.ShowLevels Columnlevels:=1
    Dim lastrow As Long
    lastrow = Cells(Rows.Count, 2).End(xlUp).Row
    ws.Range("A3:AN" & lastrow).Sort Key1:=Range("G3:G" & lastrow), _
    order1:=xlAscending, Header:=xlYes
    'ws.Protect'
    EnableSelection = xlUnlockedCells
    If ws.ProtectContents = False Then
    ws.Protect Password:=pwd, AllowFiltering:=True
    End If
    ActiveWorkbook.Save
       
End Sub
 

Excel Facts

Fastest way to copy a worksheet?
Hold down the Ctrl key while dragging tab for Sheet1 to the right. Excel will make a copy of the worksheet.
You need to qualify the ranges with the worksheet
VBA Code:
   Ws.Range("A3:AR" & LastRow).Sort Key1:=Ws.Range("G3:G" & LastRow), _
    order1:=xlAscending, Header:=xlYes
 
Upvote 0
Thanks for your response, I have adjusted the code and it worked initially but it seems like unless I am in the activesheet the code will not work.

How can I get the code to work whether I am in the active sheet or not?
 
Upvote 0
You will need to qualify all cells/ranges & other objects with the worksheet, like
VBA Code:
lastrow = Ws.Cells(Rows.Count, 2).End(xlUp).Row
 
Upvote 0
Thanks for the response Fluff, I have qualified all cells/Ranges (I think) as per below code and changed the ws references to distinguish the sheets so see if that did anything.

Still getting the same issue where upon close it will only remove filters of 1 tab & sort as apposed to 3. I have added the closing macro at the bottom just in case there's an issue with that.

VBA Code:
Sub EstateTracker()
   
 Dim ws As Worksheet
    Dim pwd
    pwd = "jason"
    Set ws = Sheet1
   
    ws.Unprotect Password:=pwd
    If ws.FilterMode Then ws.ShowAllData
    If ws.AutoFilterMode Then ws.AutoFilterMode = False
    ws.Range("A:D").Ungroup
    ws.Range("A:D").Group
    ws.Range("V:AS").Ungroup
    ws.Range("V:AS").Group
    ws.Outline.ShowLevels Columnlevels:=1
    Dim lastrow As Long
    lastrow = ws.Cells(Rows.Count, 2).End(xlUp).Row
    ws.Range("A3:AR" & lastrow).Sort Key1:=ws.Range("G3:G" & lastrow), _
    order1:=xlAscending, Header:=xlYes
    'ws.Protect'
    EnableSelection = xlUnlockedCells
    If ws.ProtectContents = False Then
    ws.Protect Password:=pwd, AllowFiltering:=True
    End If
    ActiveWorkbook.Save
       
End Sub

Sub ServiceEngineers()
   
 Dim ws4 As Worksheet
    Dim pwd
    pwd = "jason1"
    Set ws4 = Sheet4
   
    ws4.Unprotect Password:=pwd
    If ws4.FilterMode Then ws4.ShowAllData
    If ws4.AutoFilterMode Then ws4.AutoFilterMode = False
    ws4.Range("A:D").Ungroup
    ws4.Range("A:D").Group
    ws4.Range("V:AS").Ungroup
    ws4.Range("V:AS").Group
    ws4.Outline.ShowLevels Columnlevels:=1
    Dim lastrow As Long
    lastrow = ws4.Cells(Rows.Count, 2).End(xlUp).Row
    ws4.Range("A3:AR" & lastrow).Sort Key1:=ws4.Range("G3:G" & lastrow), _
    order1:=xlAscending, Header:=xlYes
    'ws4.Protect'
    EnableSelection = xlUnlockedCells
    If ws4.ProtectContents = False Then
    ws4.Protect Password:=pwd, AllowFiltering:=True
    End If
    ActiveWorkbook.Save
       
End Sub

Sub Cadtechnicians()
   
 Dim ws3 As Worksheet
    Dim pwd
    pwd = "jason2"
    Set ws3 = Sheet3
   
    ws3.Unprotect Password:=pwd
    If ws3.FilterMode Then ws3.ShowAllData
    If ws3.AutoFilterMode Then ws3.AutoFilterMode = False
    ws3.Range("A:D").Ungroup
    ws3.Range("A:D").Group
    ws3.Range("M:AA").Ungroup
    ws3.Range("M:AA").Group
    ws3.Range("AF:AH").Ungroup
    ws3.Range("AF:AH").Group
    ws3.Range("AL:AO").Ungroup
    ws3.Range("AL:AO").Group
    ws3.Outline.ShowLevels Columnlevels:=1
    Dim lastrow As Long
    lastrow = ws3.Cells(Rows.Count, 2).End(xlUp).Row
    ws3.Range("A3:AN" & lastrow).Sort Key1:=ws3.Range("G3:G" & lastrow), _
    order1:=xlAscending, Header:=xlYes
    'ws3.Protect'
    EnableSelection = xlUnlockedCells
    If ws3.ProtectContents = False Then
    ws3.Protect Password:=pwd, AllowFiltering:=True
    End If
    ActiveWorkbook.Save
       
End Sub

--------------------------------------------------------------------------------------------------------------------------------------

VBA Code:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Cadtechnicians
    ServiceEngineers
    EstateTracker
End Sub
 
Last edited by a moderator:
Upvote 0
Do you get any error messages?
Also where the the 3 subs located?
 
Upvote 0
I get the following error. The 3 subs were in separate modules and then I combined them into Module 1.

1629371465503.png
 
Upvote 0
Are any of those sheets hidden?
 
Upvote 0
In that case I'm not sure why you get the error & cannot replicate it.
 
Upvote 0

Forum statistics

Threads
1,213,526
Messages
6,114,136
Members
448,551
Latest member
Sienna de Souza

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