Solved

Need help with a sorting algorithm within Excel's sheets using an array.

Posted on 2015-01-02
8
219 Views
Last Modified: 2015-01-02
I have an array called sSheet(100) that stores each Excel's Sheet Name as it should be sorted and the total number is in variable iSheet.   Based on the what I have my Excel workbook should have the following Sheets sorted according to that array's listing from 0 to iSheet.

How do I rearrange the following to allow for the sort to exist?

'put code here to sort sheets in the order as in access..
  For j = 0 To iSheet
      
    For Each xlSheetReview In xlBook.Worksheets
      If xlSheetReview.Name = sSheet(j) Then
        
        'not sure how to handle the move code at this point.
        'this is what I found online
        '        
      End If
    Next
  Next

Open in new window

0
Comment
Question by:stephenlecomptejr
  • 5
  • 3
8 Comments
 
LVL 119

Expert Comment

by:Rey Obrero
Comment Utility
try

'put code here to sort sheets in the order as in access..
  For j = 0 To iSheet
     
    For Each xlSheetReview In xlBook.Worksheets
      If xlSheetReview.Name = sSheet(j) Then
        
            xlSheetReview.Name.Move Before:=Worksheets(j+1)
        exit for      
      End If
    Next
  Next
0
 
LVL 119

Expert Comment

by:Rey Obrero
Comment Utility
try

 'put code here to sort sheets in the order as in access..
   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
0
 
LVL 1

Author Comment

by:stephenlecomptejr
Comment Utility
I get an object required - run-time error '424' on this line item:

xlSheetReview.Name.Move Before:=xlBook.Worksheets(j + 1)

I tried also...

xlSheetReview.Name.Move Before:=xlApp.Worksheets(j + 1)

Please forgive the stupid question also:
But I know at some point you have to check if xlSheetReview.Name = sSheet(j) but does that mean you have to move it then each time you find it.  In many cases, it will not have to move at all.
0
 
LVL 119

Expert Comment

by:Rey Obrero
Comment Utility
post the whole code.
0
What Should I Do With This Threat Intelligence?

Are you wondering if you actually need threat intelligence? The answer is yes. We explain the basics for creating useful threat intelligence.

 
LVL 1

Author Comment

by:stephenlecomptejr
Comment Utility
Ok.   You asked for it.

Your section begins at:
 'CODE FOR EXPERTS-EXCHANGE STARTS HERE...
  '@@@@@@@@@@@@@

Public Sub ExportValuesToExcel(sExcel As String)

  Dim sSQL As String
  Dim rs As DAO.Recordset
  Dim sProjectName As String
  Dim sProjectNumber As String

  Dim xlApp As Object
  Dim xlBook As Object
  Dim xlSheet  As Object
  Dim xlSheetReview As Object
  Dim xlSheetNameCheck As Object
  
  Dim cell As Object
  Dim Range As Object
  
  Dim sFormula As String
  Dim sSheet(100) As String
  Dim sDiscipline(100) As String
  Dim sPhase(100) As String
  Dim sRange, sCell As String
  Dim sRange2 As String
  Dim sRangeNew As String
  Dim sRangeNew2 As String
  Dim sNewSheetName As String
  Dim bContinue As Boolean
  Dim bFound As Boolean
  
  Dim CopyThis As Object
  
  Dim i, j, k, l, m, n, o, p As Long
  Dim iSheet, iDiscipline, iPhase As Integer
  
  
  txtImporting = "Setting sheets, phases and discipline values..."
  DoEvents
  
  
  '===================================================================
  '1st step - make sure all sheets are to be shown based on selection...
  'store as an array...
  
  sSQL = "SELECT Projects_Sheets.SheetID, Projects_Sheets.SheetSort, Projects_Sheets.SheetNames"
  sSQL = sSQL & " FROM Projects_Sheets"
  sSQL = sSQL & " ORDER BY Projects_Sheets.SheetSort"
  Set rs = CurrentDb.OpenRecordset(sSQL)
  i = 0
  Do Until rs.EOF
    i = i + 1
    sSheet(i) = Nz(rs.Fields(2), "")
    Debug.Print sSheet(i)
    rs.MoveNext
  Loop
  rs.Close
  Set rs = Nothing
  iSheet = i
  

  '===================================================================
  '2nd step - store project name, number in variables.
  
  sSQL = "SELECT Projects.ProjNumber, Projects.ProjName"
  sSQL = sSQL & " FROM Projects"

  Set rs = CurrentDb.OpenRecordset(sSQL)
  If Not rs.EOF Then
    sProjectNumber = Nz(rs.Fields(0), "")
    sProjectName = Nz(rs.Fields(1), "")
  End If
  rs.Close
  Set rs = Nothing
  
  
  '===================================================================
  '3rd step - set array to how many disciplines there are...
  
  
  sSQL = "SELECT Projects_Disciplines.DisciplineID, Projects_Disciplines.DisciplineSort, Projects_Disciplines.DisciplineNames"
  sSQL = sSQL & " FROM Projects_Disciplines"
  sSQL = sSQL & " ORDER BY Projects_Disciplines.DisciplineSort;"

  Set rs = CurrentDb.OpenRecordset(sSQL)
  i = 0
  Do Until rs.EOF
    i = i + 1
    sDiscipline(i) = Nz(rs.Fields(2), "")
    Debug.Print sDiscipline(i)
    rs.MoveNext
  Loop
  rs.Close
  Set rs = Nothing
  iDiscipline = i
  
  
  '===================================================================
  '4th step - set arry to how many phases there are....
  sSQL = "SELECT Projects_Phases.PhaseID, Projects_Phases.PhaseSort, Projects_Phases.PhaseName"
  sSQL = sSQL & " FROM Projects_Phases"
  sSQL = sSQL & " ORDER BY Projects_Phases.PhaseSort;"

  Set rs = CurrentDb.OpenRecordset(sSQL)
  i = 0
  Do Until rs.EOF
    i = i + 1
    sPhase(i) = Nz(rs.Fields(2), "")
    Debug.Print sPhase(i)
    rs.MoveNext
  Loop
  rs.Close
  Set rs = Nothing
  iPhase = i
  
  txtImporting = "Opening Excel..."
  DoEvents
  'find sheet number in Excel that has...
  '
  'Home Page - list disciplines, phases vertically, deliverables
  'Contracted Fee
  'Scope Managemnet
  'Activity Items
  Set xlApp = CreateObject("Excel.Application")
  'Opens Excel TEMPlate always from the C:\ to reduce traffic
  Set xlBook = xlApp.Workbooks.Open(sExcel)
  
  'deleting sheets that are not selected in the data...
  xlApp.DisplayAlerts = False
  For Each xlSheetReview In xlBook.Worksheets
  
      bFound = False
      Debug.Print xlSheetReview.Name
      
      For j = 0 To iSheet
      
        If xlSheetReview.Name = sSheet(j) Then
          
          bFound = True
          
        End If
      Next
      
      If bFound = False Then
        sNewSheetName = xlSheetReview.Name
        xlApp.Sheets(sNewSheetName).Delete
      End If
  Next
  xlApp.DisplayAlerts = True


  For Each xlSheetReview In xlBook.Worksheets
      '
      Debug.Print xlSheetReview.Name
      
      For j = 0 To iSheet
      
        If xlSheetReview.Name = sSheet(j) Then
        
          Set xlSheet = xlBook.Worksheets(j)
          xlSheet.Activate
          xlSheet.Application.Visible = False
          
'            xlSheet.Application.ScreenUpdating = False
'            xlSheet.Application.DisplayStatusBar = False
'            xlSheet.Application.Calculation = -4135
          
          Select Case sSheet(j)
          
       
            Case "Home Page"
              'list in order down...
              xlSheet.Range("B1") = sProjectName
              xlSheet.Range("B2") = sProjectNumber
              
              k = 8
              For l = 1 To iDiscipline
                k = k + 1
                sRange = "A" & k
                sRange = Replace(sRange, " ", "")
                xlSheet.Range(sRange) = sDiscipline(l)
                
              Next l
              k = k + 2
              sRange = "A" & k
              sRange = Replace(sRange, " ", "")
              
              'm stores row where Phases is...
              m = k
              xlSheet.Range(sRange) = "Phases"
              xlSheet.Range(sRange).Font.Bold = True
              
              
              For l = 1 To iPhase
                k = k + 1
                sRange = "A" & k
                sRange = Replace(sRange, " ", "")
                xlSheet.Range(sRange) = sPhase(l)
                
              Next l
              
              'now display disciplines...
              'take the location at m
              'and fill out the disciplines as a header...
              'problem is how to identify next letter
              'as header range...
              'interesting problem...
              n = 1
              For l = 1 To iDiscipline
                n = n + 1
                xlSheet.Cells(m, n) = sDiscipline(l)
                
              Next l
              
              k = k + 2
              sRange = "A" & k
              sRange = Replace(sRange, " ", "")
              
              m = k
              xlSheet.Range(sRange) = "Deliverables"
              xlSheet.Range(sRange).Font.Bold = True
              
              n = 1
              For l = 1 To iDiscipline
                n = n + 1
                xlSheet.Cells(m, n) = sDiscipline(l)
                
              Next l
              
              xlSheet.Columns("A:A").EntireColumn.AutoFit
              
            
            
            Case "Contracted Fee"
            
              k = 2
              For l = 1 To iPhase
                k = k + 3
                sRange = "A" & k
                sRange = Replace(sRange, " ", "")
                xlSheet.Range(sRange) = sPhase(l)
                
              Next l
              m = k  'last row... 39 is the limit in the template...
              
              'find DISCIPLINE TOTAL
              'and then delete rows in between....
              
              'now display disciplines...
              k = 1
              For l = 1 To iDiscipline
                k = k + 1
                xlSheet.Cells(4, k) = sDiscipline(l)
                
              Next l
              
              'k = k + 1
              ' last column   whereas 16 is the limit in the template..
              If n < 8 Then n = 8
            
              sRange = Col_Letter(n)
              sRange2 = Col_Letter(16)
              sRangeNew = sRange & ":" & sRange2
              xlSheet.Columns(sRangeNew).Delete
              
              
         
              'delete rows until complete.
              m = m + 3
              
              sRange = m
              sRange2 = "43"
              sRangeNew = sRange & ":" & sRange2
              sRangeNew = Replace(sRangeNew, " ", "")
              xlSheet.Rows(sRangeNew).Delete
              
            
            Case "Scope Management"
              'make copies per discipline
              
              
              
              k = 0
              For l = 1 To iDiscipline
                k = k + 5
                sRange = "B" & k
                sRange = Replace(sRange, " ", "")
                xlSheet.Range(sRange) = sDiscipline(l)
                
              Next l
              
              'do this
              'last row...
              m = k + 5
              
              sRange = m
              sRange2 = "79"
              
              sRangeNew = sRange & ":" & sRange2
              sRangeNew = Replace(sRangeNew, " ", "")
              xlSheet.Rows(sRangeNew).Delete
            
            Case "Time Management"
              'first loop through each discipline and make a copy of each one and name it...

              For l = iDiscipline To 1 Step -1
              
                  sNewSheetName = "Time Management-" & sDiscipline(l)
                  If Len(sNewSheetName) > 31 Then
                    sNewSheetName = Left(sNewSheetName, 31)
                  End If
              
                  Set CopyThis = xlApp.Sheets("Time Management")
                  CopyThis.Copy After:=xlApp.Sheets("Time Management")
                  Set CopyThis = Nothing
                  Set CopyThis = xlApp.Sheets("Time Management (2)")
                  
                  CopyThis.Name = sNewSheetName
                  
                  k = 6
                  For m = 1 To iPhase
                    k = k + 1
                    sRange = "B" & k
                    sRange = Replace(sRange, " ", "")
                    
                    CopyThis.Range(sRange) = sPhase(m)
                    k = k + 2
                  Next
                  
                  m = k + 1
              
                  sRange = m
                  sRange2 = "43"
                  sRangeNew = sRange & ":" & sRange2
                  sRangeNew = Replace(sRangeNew, " ", "")
                  CopyThis.Rows(sRangeNew).Delete
                  
                  Set CopyThis = Nothing
                


              Next l
              
              'xlApp.Sheets("Time Management").Delete
              
              
              
            Case "Cost Management"
            
              For l = iDiscipline To 1 Step -1
              
                  sNewSheetName = "Cost Management-" & sDiscipline(l)
                  If Len(sNewSheetName) > 31 Then
                    sNewSheetName = Left(sNewSheetName, 31)
                  End If
                  
                

                  Set CopyThis = xlApp.Sheets("Cost Management")
                  CopyThis.Copy After:=xlApp.Sheets("Cost Management")
                  Set CopyThis = Nothing
                  Set CopyThis = xlApp.Sheets("Cost Management (2)")
                  
                  
                  CopyThis.Name = sNewSheetName
                  
                  'copy rows....
                  o = 9
                  
                  k = 8
                  For m = 1 To iPhase
                    k = k + 1
                    
                    If m > 1 Then
                  
                      o = o + 14
                      p = o + 13
                      sRange = "9"
                      sRange2 = "22"
                      sRangeNew = sRange & ":" & sRange2
                      sRangeNew = Replace(sRangeNew, " ", "")
                      sRangeNew2 = o & ":" & p
                      sRangeNew2 = Replace(sRangeNew2, " ", "")
                      CopyThis.Rows(sRangeNew).Copy Destination:=xlApp.Worksheets(sNewSheetName).Range(sRangeNew2)
                  
                    End If
                    
                    sRange = "A" & k
                    sRange = Replace(sRange, " ", "")
                    
                    CopyThis.Range(sRange) = sPhase(m)
                    k = k + 13
                  Next
                  
                  Set CopyThis = Nothing
                

                

              Next l
              'xlApp.Sheets("Cost Management").Delete
              
            
            Case "Activity List"
            
              n = 0
              For l = 1 To iDiscipline
                n = n + 1
                xlSheet.Cells(3, n) = sDiscipline(l)
              Next l
              m = l
              
              k = 3
              For l = 1 To iPhase
                
                k = k + 1
                
                For n = 1 To m
                  xlSheet.Cells(k, n) = sPhase(l)
                Next n
                k = k + 13
                
              Next l
              
              
              'Stop
              m = k + 1
              sRange = m
              sRange2 = "185"
              sRangeNew = sRange & ":" & sRange2
              sRangeNew = Replace(sRangeNew, " ", "")
              xlSheet.Rows(sRangeNew).Delete
              
              sRange = Col_Letter(iDiscipline + 1)
              sRange2 = Col_Letter(16)
              sRangeNew = sRange & ":" & sRange2
              xlSheet.Columns(sRangeNew).Delete
              
              
            
            Case Else
              'do that
          
          
          End Select
          
          'xlSheet.Application.ScreenUpdating = True
          'xlSheet.Application.DisplayStatusBar = True
          'xlSheet.Application.Calculation = -4105
          
          Set xlSheet = Nothing
          Exit For
        
        End If
      
      
      Next j
  Next


  
  xlApp.DisplayAlerts = False
  For Each xlSheetReview In xlBook.Worksheets
    If xlSheetReview.Name = "Cost Management" Then
      xlApp.Sheets("Cost Management").Delete
      Exit For
    End If
  Next

  For Each xlSheetReview In xlBook.Worksheets
    If xlSheetReview.Name = "Time Management" Then
      xlApp.Sheets("Time Management").Delete
      Exit For
    End If
  Next
  xlApp.DisplayAlerts = True
  
  '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
  
  
  Set xlSheet = xlBook.Worksheets(1)
  xlSheet.Activate
  Set xlSheet = Nothing
  
  xlBook.Save
  xlBook.Close
  Set xlBook = Nothing
  Set xlApp = Nothing
 
 
End Sub

Open in new window

0
 
LVL 119

Accepted Solution

by:
Rey Obrero earned 500 total points
Comment Utility
try

xlBook.Worksheets(xlSheetReview.Name).Move Before:=xlBook.Worksheets(j + 1)
0
 
LVL 119

Expert Comment

by:Rey Obrero
Comment Utility
if that does not work, try

xlApp.Worksheets(xlSheetReview.Name).Move Before:=xlApp.Worksheets(j + 1)
0
 
LVL 1

Author Comment

by:stephenlecomptejr
Comment Utility
That worked.  Thank you.
0

Featured Post

Complete Microsoft Windows PC® & Mac Backup

Backup and recovery solutions to protect all your PCs & Mac– on-premises or in remote locations. Acronis backs up entire PC or Mac with patented reliable disk imaging technology and you will be able to restore workstations to a new, dissimilar hardware in minutes.

Join & Write a Comment

I see at least one EE question a week that pertains to using temporary tables in MS Access.  But surprisingly, I was unable to find a single article devoted solely to this topic. I don’t intend to describe all of the uses of temporary tables in t…
Over the years I have built up my own little library of code snippets that I refer to when programming or writing a script.  Many of these have come from the web or adaptations from snippets I find on the Web.  Periodically I add to them when I come…
This Micro Tutorial will demonstrate in Google Sheets how to use the HYPERLINK function to create live links inside your spreadsheet.
Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custo…

772 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

11 Experts available now in Live!

Get 1:1 Help Now