Still celebrating National IT Professionals Day with 3 months of free Premium Membership. Use Code ITDAY17

x
Solved

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

Posted on 2015-01-02
Medium Priority
228 Views
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
``````
0
Question by:stephenlecomptejr
[X]
###### Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

• Help others & share knowledge
• Earn cash & points
• 5
• 3

LVL 120

Expert Comment

ID: 40528692
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 120

Expert Comment

ID: 40528705
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

ID: 40528720
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 120

Expert Comment

ID: 40528723
post the whole code.
0

LVL 1

Author Comment

ID: 40528725

'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...
'
'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...
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

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)

'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
'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

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

'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
``````
0

LVL 120

Accepted Solution

Rey Obrero (Capricorn1) earned 2000 total points
ID: 40528738
try

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

LVL 120

Expert Comment

ID: 40528740
if that does not work, try

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

LVL 1

Author Comment

ID: 40528769
That worked.  Thank you.
0

## Featured Post

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This article describes a serious pitfall that can happen when deleting shapes using VBA.
After seeing numerous questions for Dynamic Data Validation I notice that most have used Visual Basic to solve the problem. This suggestion is purely formula based and can be used in multiple rows.
Access reports are powerful and flexible. Learn how to create a query and then a grouped report using the wizard. Modify the report design after the wizard is done to make it look better. There will be another video to explain how to put the final pâ€¦
Many functions in Excel can make decisions. The most simple of these is the IF function: it returns a value depending on whether a condition you describe is true or false. Once you get the hang of using the IF function, you will find it easier to usâ€¦
###### Suggested Courses
Course of the Month5 days, 19 hours left to enroll