Solved

Need help with sorting algorithm for Excel - Part 2

Posted on 2015-01-27
33
185 Views
Last Modified: 2016-02-11
So this question piggy backs off of this initiatlly:

http://www.experts-exchange.com/Database/MS_Access/Q_28589929.html#a40528740

The sorting worked up to a point.  Whereas if you were to list the data like so:

For Each xlSheetReview In xlBook.Worksheets
  Debug.Print xlSheetReview.Name
Next 

Open in new window


you would get:

Contracted Fee
Stakeholder Management
Time Mgmt-Acoustics
Time Mgmt-Audiovisual
Time Mgmt-Security
Risk Management
Quality Control
Cheat Sheet

If you were to list the Sheet Sorting order to go by:

For j = 1 To iSheet
  Debug.Print sSheet(j)
next j

Open in new window


you would get:

Contracted Fee
Stakeholder Management
Time Mgmt
Risk Management
Quality Control
Cheat Sheet

So how do I adjust the following syntax to still allow a correct sorting of the Excel sheets when I have added to the sheet name extensions?

For j = 1 To iSheet

      For Each xlSheetReview In xlBook.Worksheets
        bSort = False
        
        If xlSheetReview.Name = sSheet(j) And j + 1 < iSheet Then
            xlBook.Worksheets(xlSheetReview.Name).Move Before:=xlBook.Worksheets(j + 1)
            Exit For
        End If

      Next

  Next

Open in new window


Currently the above gives me the ending result of:

Contracted Fee
Stakeholder Management
Time Mgmt-Acoustics
Time Mgmt-Audiovisual
Risk Management
Time Mgmt-Security
Quality Control
Cheat Sheet

Which does not put Time Mgmt-Security with the rest of Time Mgmt....

Please let me know if I need to provided further answers...  Again, I've gone a step farther and put in the data values of each.

Thank you in advance.
0
Comment
Question by:stephenlecomptejr
  • 15
  • 14
  • 4
33 Comments
 
LVL 29

Expert Comment

by:gowflow
ID: 40572565
This routine should sort the worksheets in a workbook depending on the answer if yes ascending if no descending.

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

Open in new window


gowflow
0
 
LVL 1

Author Comment

by:stephenlecomptejr
ID: 40573079
This comment will definitely not work.  I can't have the user to go through 20+ worksheets and determine if they are to be sorted manually.  Come on - man - or you kidding me?
0
 
LVL 1

Author Comment

by:stephenlecomptejr
ID: 40573096
Here's a sample Excel file.

Then please note this coding already set up.
Please run and see if this doesn't sort such correctly:

Public Sub SortingNumbers()

  Dim xlSheetReview As Object
  Dim xlApp As Object
  Dim xlBook As Object
  Dim xlSheet  As Object
  Dim sExcel As String
  Dim iSheet As Integer
  Dim j As Integer
  Dim sSheet(100) As String

  sExcel = "C:\Samples\PMTest.xlsx"
  Set xlApp = CreateObject("Excel.Application")
  Set xlBook = xlApp.Workbooks.Open(sExcel)
  Set xlSheet = xlBook.Worksheets(1)
  xlSheet.Activate
  xlSheet.Application.Visible = True
  
  sSheet(1) = "Contracted Fee"
  sSheet(2) = "Stakeholder Management"
  sSheet(3) = "Scope Management"
  sSheet(4) = "Change Log"
  sSheet(5) = "Action Items"
  sSheet(6) = "Time Mgmt"
  sSheet(7) = "Cost Mgmt"
  sSheet(8) = "Communications Plan"
  sSheet(9) = "Risk Management"
  sSheet(10) = "Quality Control"
  sSheet(11) = "Cheat Sheet"
  iSheet = 11
  
  For j = 1 To iSheet
      For Each xlSheetReview In xlBook.Worksheets
        If xlSheetReview.Name = sSheet(j) And j + 1 < iSheet Then
            xlBook.Worksheets(xlSheetReview.Name).Move Before:=xlBook.Worksheets(j + 1)
            Exit For
        End If
      Next
  Next
  
  Set xlSheet = Nothing
  Set xlBook = Nothing
  Set xlApp = Nothing


End Sub

Open in new window

PMTest.xlsx
0
 
LVL 119

Expert Comment

by:Rey Obrero
ID: 40573260
what exactly is your goal?
0
 
LVL 119

Expert Comment

by:Rey Obrero
ID: 40573296
try first this codes

Sub getWorksheetsName()
Dim xlObj As Object, sExcel As String, j As Integer
 sExcel = CurrentProject.Path & "\PMTest.xlsx"
Set xlObj = CreateObject("Excel.Application")
    xlObj.workbooks.Open sExcel
    xlObj.Visible = True
    With xlObj
        For j = 1 To .worksheets.Count
            Debug.Print .worksheets(j).Name
        Next
    End With
    xlObj.Quit
End Sub
0
 
LVL 1

Author Comment

by:stephenlecomptejr
ID: 40573299
Hey Rey, I've got the Excel sample file as a download - are you able to review it?
I don't need to debug.print - I've posted what that files shows as a download....
0
 
LVL 119

Expert Comment

by:Rey Obrero
ID: 40573315
i got your file, how do you want to do the sorting? which sheet is 1st, 2nd ...etc, last?
0
 
LVL 29

Expert Comment

by:gowflow
ID: 40573316
I don't understand what you want but anyway check this file.

It has the macro I already posted. To test it do the following:

1) Load the file.
2) Enable Macroes.
3) Press on the Developper Tab and choose Macroes and run the Macro that is there.

You will be prompt if you want to sort the workbook in ascending or descending order. If you press Yes it will AUTOMATICALLY sort it in ascending order if NO then in Descending order.

Let me know if this is what you want.
gowflow
PMTest.xlsm
0
 
LVL 29

Expert Comment

by:gowflow
ID: 40573326
Is this order you want your sheets to be ?? A specific order ???

sSheet(1) = "Contracted Fee"
  sSheet(2) = "Stakeholder Management"
  sSheet(3) = "Scope Management"
  sSheet(4) = "Change Log"
  sSheet(5) = "Action Items"
  sSheet(6) = "Time Mgmt"
  sSheet(7) = "Cost Mgmt"
  sSheet(8) = "Communications Plan"
  sSheet(9) = "Risk Management"
  sSheet(10) = "Quality Control"
  sSheet(11) = "Cheat Sheet"


? pls advise as your request is not clear.
gowflow
0
 
LVL 29

Expert Comment

by:gowflow
ID: 40573337
Sorry I don't understand your comment about
'Sorting Manually'

Are you referring to my solution ???

I am not proposing a solution to sort manually. Can you please clarify ?

gowflow
0
 
LVL 1

Author Comment

by:stephenlecomptejr
ID: 40573339
Yes this is the order I want the sheets to be.
0
 
LVL 1

Author Comment

by:stephenlecomptejr
ID: 40573342
Are you referring to my solution ???    Yes.

 Prompt the user as which direction they wish to
 sort the worksheets.

that's a manual sort.
0
 
LVL 1

Author Comment

by:stephenlecomptejr
ID: 40573347
It will always be in ascending order.
I don't need someone to ask whether ascending or descending.

It's a straight sort A-Z.
0
 
LVL 29

Expert Comment

by:gowflow
ID: 40573350
I am sorry can you pleas clarify then what you need ?

Do you want a specific sort ? I don't understand what is required. I am sorry if I misunderstood your request only trying to help.

gowflow
0
 
LVL 1

Author Comment

by:stephenlecomptejr
ID: 40573353
"I don't understand what you want but anyway check this file.

 It has the macro I already posted. To test it do the following:

 1) Load the file.
 2) Enable Macroes.
 3) Press on the Developper Tab and choose Macroes and run the Macro that is there.

 You will be prompt if you want to sort the workbook in ascending or descending order. If you press Yes it will AUTOMATICALLY sort it in ascending order if NO then in Descending order.

 Let me know if this is what you want."

This macro does not sort as to what is listed via sSheet(1-11) - that is the baseline as to how these should be sorted.
0
 
LVL 1

Author Comment

by:stephenlecomptejr
ID: 40573354
"Rey Obrero (Microsoft Access MVP)2015-01-27 at 11:37:21ID: 40573315

i got your file, how do you want to do the sorting? which sheet is 1st, 2nd ...etc, last? "

Use the sSheet(1-11) as the baseline as how these should be sorted.
0
How to improve team productivity

Quip adds documents, spreadsheets, and tasklists to your Slack experience
- Elevate ideas to Quip docs
- Share Quip docs in Slack
- Get notified of changes to your docs
- Available on iOS/Android/Desktop/Web
- Online/Offline

 
LVL 29

Expert Comment

by:gowflow
ID: 40573359
our answers crossed then no problem here it is:

Try this one. no question asked Sort ascending.

gowflow
PMTest-V01.xlsm
0
 
LVL 29

Expert Comment

by:gowflow
ID: 40573361
Oops so you need a sort Specific then !!!
ok 1 moment

gowflow
0
 
LVL 29

Expert Comment

by:gowflow
ID: 40573366
But the workbook you posted hve more than 11 sheets how do you want the balance to be sorted ?
gowlfow
0
 
LVL 1

Author Comment

by:stephenlecomptejr
ID: 40573386
Exactly... that's the problem.  Some of the Time Mgmt has an extender that will be dynamic at times.
Same condition with Cost Mgmt.

The flow should be:

Contracted Fee
Stakeholder Management
Scope Management
Change Log
Action Items
Time Mgmt-Acoustics    <-- these obviously run ascending after Time Mgmt - just as long as Time Mgmt is between Cost Mgmt and Action Items as per the sSheet(1-11)
Time Mgmt-Audiovisual
Time Mgmt-Infrastructure
Time Mgmt-IT Systems
Time Mgmt-Security
Time Mgmt-Theater Planning
Cost Mgmt-Acoustics   <-- same with Cost Mgmt
Cost Mgmt-Audiovisual
Cost Mgmt-Infrastructure
Cost Mgmt-IT Systems
Cost Mgmt-Security
Cost Mgmt-Theater Planning
Communications Plan
Risk Management
Quality Control
Cheat Sheet-Acoustics    <--- same with Cheat Sheet...
Cheat Sheet-Infrastructure  
Cheat Sheet-Security
0
 
LVL 29

Expert Comment

by:gowflow
ID: 40573410
ok got it !!!

Sorry I am solowwwww

I created a sheet Main (if you don't mind) we can change this if all is ok. I have put the order that you want you can shuffle as much as you like in Col A) then once done simply click on the button Sort Specific !

I think it need fine-tuning within the same item but will wait to hear from you.

gowflow
PMTest-V02.xlsm
0
 
LVL 1

Author Comment

by:stephenlecomptejr
ID: 40573459
Please note image attachment.

Time Mgmt-Theater Planning shows before Time Mgmt-Acoustics... that would be wrong.

Also as the Sort Specific code I see:

Sub SpecificSort()
On Error GoTo ErrHandler

Dim WS As Worksheet
Dim rng As Range
Dim sNames As String
Dim cCell As Range
 
Set rng = ActiveSheet.Range(Range("A1"), Cells(Rows.Count, 1).End(xlUp))

'---> Set them in the desired order
For Each cCell In rng.Cells
    For Each WS In ActiveWorkbook.Worksheets
        If InStr(1, WS.Name, cCell) <> 0 Then
            Sheets(WS.Name).Move after:=Sheets(Sheets.Count)
        End If
    Next WS
    'If sNames <> "" Then sNames = sNames & ";"
    'sNames = sNames & cCell.Value
Next

'---> Put the rest at the end
'For Each WS In ActiveWorkbook.Worksheets
'    If InStr(1, sNames, WS.Name) = 0 Then
'        WS.Move after:=Sheets(Sheets.Count)
'    End If
'Next WS

'---> Activate orignal sheet
rng.Parent.Activate

Exit Sub

ErrHandler:
If Err = 9 Then
    MsgBox "Sheet " & cCell.Value & " does not exist !"
    Resume Next
End If
End Sub

Open in new window


Per the above code - how does it use the sSheet(1-11) as the guide to sort?
SortCapture.PNG
0
 
LVL 29

Expert Comment

by:gowflow
ID: 40573508
I know I am working on it. Pls give me sometime.

If you want to solve it quickly just list in Col A each and every single sheet in the sort you want and it will do it.

But I will work on a solution so you only list the header like Time Mgmt and it should sort all the rest from A-Z

Pls be patient !
gowflow
0
 
LVL 29

Expert Comment

by:gowflow
ID: 40573679
I think this one should do it. Pls check it out.
gowflow
PMTest-V03.xlsm
0
 
LVL 1

Author Comment

by:stephenlecomptejr
ID: 40573732
That's the trick of the algorithm - get the sSheet(array) to readjust or relist to what the actual listing of the worksheet names as they have it.  You have 4 factors:

If Left(xlSheetReview.Name, 4) = "Time" Then
             
            End If
            If Left(xlSheetReview.Name, 4) = "Cost" Then
             
            End If
           
            If Left(xlSheetReview.Name, 5) = "Cheat" Then
             
            End If

If Left(xlSheetReview.Name, 4) <> "Time" And Left(xlSheetReview.Name, 4) <> "Cost" And Left(xlSheetReview.Name, 5) = "Cheat" Then

End if
0
 
LVL 29

Expert Comment

by:gowflow
ID: 40573757
did u chk what I posted?
goowflow
0
 
LVL 1

Author Comment

by:stephenlecomptejr
ID: 40573797
It works.  But I won't be able to use any of this.

I'm using Access VBA - and need to use the code I have posted.

I'm not going to be able to have another sheet listed with the way it's shown (at the beginning) with the way it should be sorted just to make it work.

For j = 1 To iSheet

      For Each xlSheetReview In xlBook.Worksheets
        bSort = False
        
        If xlSheetReview.Name = sSheet(j) And j + 1 < iSheet Then
            xlBook.Worksheets(xlSheetReview.Name).Move Before:=xlBook.Worksheets(j + 1)
            Exit For
        End If

      Next

  Next

Open in new window


Everything is late binded and will not be able to use any terms that have Dim rng As Range or Dim cCell As Range
0
 
LVL 29

Expert Comment

by:gowflow
ID: 40573808
Welll you shouldn't hv put Excel Zone then.
gowflow
0
 
LVL 119

Expert Comment

by:Rey Obrero
ID: 40573848
@stephenlecomptejr

<Use the sSheet(1-11) as the baseline as how these should be sorted. >

what about the rest of the worksheets.

can you just itemized sorted them and post here.
0
 
LVL 29

Expert Comment

by:gowflow
ID: 40573867
ok try this version not too familiar with Access VBA but removed all the early binding. as well as sheet Main all hard coded.

gowflow
PMTest-V04.xlsm
0
 
LVL 29

Assisted Solution

by:gowflow
gowflow earned 500 total points
ID: 40573904
If you need to integrate my solution to your access (I lookup your initial previous question) then all you need to do is the following:

1) Add in the module of your workbook in Access the following code:
Sub SpecificSort()
On Error GoTo ErrHandler

Dim WS As Object
Dim Rng As Variant
Dim I As Long, J As Long
Dim WSM As Object
Dim MaxRow As Long

With Application
    .EnableEvents = False
    .ScreenUpdating = False
End With


Set WSM = ActiveSheet
'Set rng = ActiveSheet.Range(Range("A1"), Cells(Rows.Count, 1).End(xlUp))
Rng = Array("Contracted Fee", "Stakeholder Management", "Scope Management", "Change Log", "Action Items", "Time Mgmt", "Cost Mgmt", "Communications Plan", "Risk Management", "Quality Control", "Cheat Sheet")

'---> Set them in the desired order
For J = LBound(Rng) To UBound(Rng)
                
        '---> Put them at the end
        For Each WS In ActiveWorkbook.Worksheets
            If InStr(1, WS.Name, Rng(J)) <> 0 Then
                WS.Move after:=Sheets(Sheets.Count)
            End If
        Next WS
        
        '---> Find all of same group
        MaxRow = 0
        WSM.Range("Z:Z").ClearContents
        For I = 1 To Sheets.Count
            If InStr(1, Sheets(I).Name, Rng(J)) <> 0 Then
                WSM.Range("Z" & MaxRow + 1) = Sheets(I).Name
                MaxRow = MaxRow + 1
            End If
        Next I
        
        '---> Sort within the same group
        WSM.Range("Z:Z").Sort Key1:=WSM.Range("Z1"), order1:=xlAscending, Header:=False, MatchCase:=False
        
        '---> Sort the Sheets
        For I = 1 To MaxRow
            Sheets(WSM.Range("Z" & I).Value).Move after:=Sheets(Sheets.Count)
        Next I
        
        '---> Clear the Sub
        WSM.Range("Z:Z").ClearContents
        
Next J

With Application
    .EnableEvents = True
    .ScreenUpdating = True
End With
'---> Activate orignal sheet
Rng.Parent.Activate

Exit Sub

ErrHandler:
If Err = 9 Then
    'MsgBox "Sheet " & rng(J).Value & " does not exist !"
    Resume Next
End If
End Sub

Open in new window


2) then replace in your code this part
'CODE FOR EXPERTS-EXCHANGE STARTS HERE...
  '@@@@@@@@@@@@@
  
  For j = 0 To iSheet

      For Each xlSheetReview In xlBook.Worksheets
        If xlSheetReview.Name = sSheet(j) Then
              xlSheetReview.Name.Move Before:=xlBook.Worksheets(j + 1)
          Exit For
        End If
      Next

  Next

Open in new window


By this part
'CODE FOR EXPERTS-EXCHANGE STARTS HERE...
  '@@@@@@@@@@@@@
  
SpecificSort

Open in new window



Let me know
gowflow
0
 
LVL 1

Accepted Solution

by:
stephenlecomptejr earned 0 total points
ID: 40573950
I do not think that will work for me gowflow.
But I can give you credit for an idea you gave me.

Basically the premise is first get a proper list to sort by and then I can do the following:

For j = 0 To i - 1
    For Each xlSheetReview In xlBook.Worksheets
      If xlSheetReview.Name = sSheetSort(j) Then
           xlBook.Worksheets(xlSheetReview.Name).Move Before:=xlBook.Worksheets(j + 1)
        Exit For
      End If
    Next
  Next

Open in new window


Please note the following code that is working for me just fine:
Basically I create another sSheetSort(array) to go by and look for the 3 anamolies - Cost, Time and Cheat....

Dim sSheetSort(100) As String
  Dim iSheetSort(100) As Integer
  
  Dim kTime As Integer
  Dim kCost As Integer
  Dim kCheat As Integer
  
  Dim sTime(100) As String
  Dim sCost(100) As String
  Dim sCheat(100) As String
  
  Dim bTime As Boolean
  Dim bCost As Boolean
  Dim bCheat As Boolean
  
  kTime = 0
  For Each xlSheetReview In xlBook.Worksheets
    sNewSheetName = xlSheetReview.Name
    If Left(sNewSheetName, 9) = "Time Mgmt" Then
      kTime = kTime + 1
      sTime(kTime) = sNewSheetName
    End If
  Next
  kCost = 0
  For Each xlSheetReview In xlBook.Worksheets
    sNewSheetName = xlSheetReview.Name
    'Debug.Print sNewSheetName
    If Left(sNewSheetName, 9) = "Cost Mgmt" Then
      kCost = kCost + 1
      sCost(kCost) = sNewSheetName
    End If
  Next
  kCheat = 0
  For Each xlSheetReview In xlBook.Worksheets
    sNewSheetName = xlSheetReview.Name
    If Left(sNewSheetName, 11) = "Cheat Sheet" Then
      kCheat = kCheat + 1
      sCheat(kCheat) = sNewSheetName
    End If
  Next
  i = 0
  bTime = False
  bCost = False
  bCheat = False
  For Each xlSheetReview In xlBook.Worksheets
    sNewSheetName = xlSheetReview.Name
    For j = 1 To iSheet
    
      If sNewSheetName = sSheet(j) And sNewSheetName <> "Time Mgmt" And sNewSheetName <> "Cost Mgmt" And sNewSheetName <> "Cheat Sheet" Then
        i = i + 1
        sSheetSort(i) = sNewSheetName
        Exit For
        
      Else
      
      
        If Left(sNewSheetName, 9) = "Time Mgmt" And bTime = False Then
          For k = 1 To kTime
            i = i + 1
            sSheetSort(i) = sTime(k)
          Next k
          bTime = True
          Exit For
        End If
        
        If Left(sNewSheetName, 9) = "Cost Mgmt" And bCost = False Then
          For k = 1 To kCost
            i = i + 1
            sSheetSort(i) = sCost(k)
          Next k
          bCost = True
          Exit For
        End If
        
        If Left(sNewSheetName, 11) = "Cheat Sheet" And bCheat = False Then
          For k = 1 To kCheat
            i = i + 1
            sSheetSort(i) = sCheat(k)
          Next k
          bCheat = True
          Exit For
        End If
      End If
    Next j
  Next
  
'  For j = 0 To i
'    Debug.Print sSheetSort(j)
'  Next j
'
  
  For j = 0 To i - 1
    For Each xlSheetReview In xlBook.Worksheets
      If xlSheetReview.Name = sSheetSort(j) Then
           xlBook.Worksheets(xlSheetReview.Name).Move Before:=xlBook.Worksheets(j + 1)
        Exit For
      End If
    Next
  Next
  

Open in new window

0
 
LVL 1

Author Closing Comment

by:stephenlecomptejr
ID: 40582250
Appreciate all the replies but it was the idea that led me to make the code that works for my situation.  Thank you sincerely.
0

Featured Post

Highfive + Dolby Voice = No More Audio Complaints!

Poor audio quality is one of the top reasons people don’t use video conferencing. Get the crispest, clearest audio powered by Dolby Voice in every meeting. Highfive and Dolby Voice deliver the best video conferencing and audio experience for every meeting and every room.

Join & Write a Comment

In a multiple monitor setup, if you don't want to use AutoCenter to position your popup forms, you have a problem: where will they appear?  Sometimes you may have an additional problem: where the devil did they go?  If you last had a popup form open…
Modern/Metro styled message box and input box that directly can replace MsgBox() and InputBox()in Microsoft Access 2013 and later. Also included is a preconfigured error box to be used in error handling.
The viewer will learn how to use a discrete random variable to simulate the return on an investment over a period of years, create a Monte Carlo simulation using the discrete random variable, and create a graph to represent the possible returns over…
This Micro Tutorial demonstrates how to create Excel charts: column, area, line, bar, and scatter charts. Formatting tips are provided as well.

747 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

9 Experts available now in Live!

Get 1:1 Help Now