PDA

View Full Version : [SOLVED:] Sorting all worksheets but exclude 3 worksheets



oam
10-02-2015, 09:39 AM
There are a lot of sorting macros on the web to include this forum and the one shown below but I have been unable to find one that will sort all the worksheets except for certain worksheets. What I have is a macro that builds worksheets from a master worksheet and names the worksheets based on that list.

Is there a way to either exclude certain worksheets from the sorting code or have a code sort the worksheets based on the list which the worksheets that I want excluded are NOT listed there.

Thank you for your time and help


Sub Sort_Active_Book()Dim i As Integer
Dim j As Integer
Dim iAnswer As VbMsgBoxResult
'
' Prompt the user as which direction they wish to
' sort the worksheets.
'
iAnswer = MsgBox("Sort Sheets in Ascending Order?" & Chr(10) _
& "Clicking No will sort in Descending Order", _
vbYesNoCancel + vbQuestion + vbDefaultButton1, "Sort Worksheets")
For i = 1 To Sheets.Count
For j = 1 To Sheets.Count - 1
'
' If the answer is Yes, then sort in ascending order.
'
If iAnswer = vbYes Then
If UCase$(Sheets(j).Name) > UCase$(Sheets(j + 1).Name) Then
Sheets(j).Move After:=Sheets(j + 1)
End If
'
' If the answer is No, then sort in descending order.
'
ElseIf iAnswer = vbNo Then
If UCase$(Sheets(j).Name) < UCase$(Sheets(j + 1).Name) Then
Sheets(j).Move After:=Sheets(j + 1)
End If
End If
Next j
Next i

End Sub

p45cal
10-02-2015, 11:26 AM
Are the 3 sheets you want excluded from the sort already in the right place, say the leftmost three tabs? Then try changing your loop to for i = 4 to Sheets.count-1.
If that doesn't work, give us a workbook to play with with just the sheets and the list of sheet names on the master worksheet.

oam
10-02-2015, 02:23 PM
Thank you for your quick reply.

Yes, the sheets I do not want included into the worksheet sort are all the way to the left. I have included i = 4 to Sheets.count-1 into the code but it only prevents the worksheet furthest to the left from sorting, weird!

Due to the sensitive nature of the information I will be unable to provide a sample of the spread sheet.

p45cal
10-02-2015, 03:04 PM
Make up a workbook with sheets and a masterworksheet with a list where you have your list. No sensitive data required.

SamT
10-02-2015, 07:08 PM
Try Turning off Screen updating and Events enabling, then activating the three sheets in turn before running the sort routine.

Assuming that the number of sheets changes, place all the sheet names except those three into an array, sorting the array then move the sheets according to the sorted array.

Why are you sorting the tab order, anyway?

Paul_Hossler
10-02-2015, 07:43 PM
Try something like this. Slightly different, but basically the same

However, WS 'Sheet10' sort ascending before WS 'Sheet2' if that's a problem




Option Explicit
Sub Sort_Active_Book()
Dim i As Integer
Dim j As Integer
Dim ws As Worksheet
Dim iAnswer As VbMsgBoxResult
Dim aSheets() As Worksheet

'
' Prompt the user as which direction they wish to
' sort the worksheets.
'
iAnswer = MsgBox("Sort Sheets in Ascending Order?" & Chr(10) _
& "Clicking No will sort in Descending Order", _
vbYesNoCancel + vbQuestion + vbDefaultButton1, "Sort Worksheets")

If iAnswer = vbCancel Then Exit Sub ' added

ReDim aSheets(1 To Worksheets.Count)
For i = LBound(aSheets) To UBound(aSheets)
Set aSheets(i) = Worksheets(i)
Next i

'sort all descending
For i = 4 To UBound(aSheets) - 1
For j = i To UBound(aSheets)
If aSheets(i).Name < aSheets(j).Name Then
Set ws = aSheets(i)
Set aSheets(i) = aSheets(j)
Set aSheets(j) = ws
End If
Next j
Next i

If iAnswer = vbYes Then
For i = 4 To UBound(aSheets)
aSheets(i).Move After:=aSheets(3)
Next i
Else
For i = UBound(aSheets) To 4 Step -1
aSheets(i).Move After:=aSheets(3)
Next i
End If

End Sub

Paul_Hossler
10-04-2015, 09:22 AM
However, WS 'Sheet10' sort ascending before WS 'Sheet2' if that's a problem



Better explanation:

WS 'Sheet10' sorts (when using ascending order) before WS 'Sheet2' because in the generic collating sequence '10' < '2'

Depending of that your WS's are really called, it might not be an issue

snb
10-04-2015, 12:06 PM
Sub M_snb()
With CreateObject("System.Collections.ArrayList")
For Each sh In Sheets
.Add sh.Name
Next
.Sort

sn = .toarray
For j = 0 To UBound(sn)
Sheets(sn(j)).Move Sheets(j + 1)
Next
End With
End Sub


you can exclude sheets "expres","never" and 'always' using:


Sub M_snb()
With CreateObject("System.Collections.ArrayList")
For Each sh In Sheets
if instr("expresneveralways",sh.name)=0 then .Add sh.Name
Next
.Sort

sn = .toarray
For j = 0 To UBound(sn)
Sheets(sn(j)).Move Sheets(j + 1)
Next
End With
End Sub

SamT
10-04-2015, 03:43 PM
I just added this thread to my KB and this line to my brain

If instr("expresneveralways",sh.name)=0 Then .Add sh.Name

Paul_Hossler
10-04-2015, 05:02 PM
IMHO this is a risky approach



If instr("expresneveralways",sh.name)=0 Then .Add sh.Name


It would fail for any sheet that had the bad luck to be a substring of the expression, or a overlap of them

It would fail (i.e. fail to .Add) for a WS named 'ways' and 'pres' and 'exp' or 'veral' and be very hard to track down


It'd be safer I think to use



If instr(Chr(1) & "expres" & Chr(1) & "never" & Chr(1) & "always" & Chr(1), Chr(1) & sh.name & Chr(1))=0 Then .Add sh.Name

SamT
10-04-2015, 05:29 PM
As always, one has to use VBA common sense when designing Workbooks.

Paul_Hossler
10-04-2015, 05:52 PM
No one can control users

All it would take would be for a user to insert and name a worksheet something like 'exp' and the InStr would not work as intended

I spend most of my VBA time user-proofing workbooks

mikerickson
10-04-2015, 06:18 PM
I think something like this would work. As indicated, it would be best to use code names rather than tab names on the indicated lines.


Sub test()
Dim i As Long
Dim j As Long
Dim SortAscending As Long

SortAscending = MsgBox("Sort Assending? (no=descending)", vbYesNoCancel)
If SortAscending = vbCancel Then Exit Sub
Application.ScreenUpdating = False

With ThisWorkbook

.Sheets("Sheet1").Move before:=.Sheets(1): Rem code name prefered
.Sheets("Sheet2").Move before:=.Sheets(2): Rem code name prefered
.Sheets("Sheet3").Move before:=.Sheets(3): Rem code name prefered

For i = 4 To .Sheets.Count
For j = 4 To i - 1
If (LCase(.Sheets(i).Name) < LCase(.Sheets(j).Name)) Xor (SortAscending = vbNo) Then
.Sheets(i).Move before:=.Sheets(j)
End If
Next j
Next i

End With
Application.ScreenUpdating = True
End Sub

snb
10-05-2015, 12:27 AM
@Paul

At first we start simple


If instr("expresneveralways",sh.name)=0 Then .Add sh.Name
If that fits, OK
If it doesn't we'll turn on 'sophistication'


If instr("_expres_never_always_",sh.name)=0 Then .Add sh.Name


if that fits, OK
If it doesn't, we'll turn up the volume


If iserror(application.match(sh.name,array("expres","never","always"),0)) Then .Add sh.Name


In answering questions I prefer to start simple, especially since we have no context information.
Turning to 'complicated' later on is always an option.
I abhor from code that is intended to cover all terrestrial & extraterrestrial possibilities.

Paul_Hossler
10-05-2015, 06:48 AM
I abhor from code that is intended to cover all terrestrial & extraterrestrial possibilities.


1. You must have better users that I do

2. I tend / prefer to use 'toolbox' modules that can be included in projects so I like to make the module as general as I can so it can be reused easily.

mikerickson
10-05-2015, 11:34 AM
"User's are like Shakespere's monkeys. You never know what button they are going to press."

oam
10-16-2015, 07:31 PM
Thank all of you for all your quick reply and soory it has been a long time since my post but I have been a little out of pocket for a while.

I was able to use "snb" information and it did work.

Again, thank you all; you are great bunch of people!