Pick a folder and consolidate workbooks I'm trying to create a simple way for current &amp; future (non VBA literate) employees to accomplish some of the tasks I've struggled with. The first being Parsing cells containing Line Feed Characters.

When reports are produced from Workday, sometimes they have to be produced for each item separately, and you end up with a folder like this -



Within each book is a sheet of the same name, but cut off at 31 characters (the maximum for sheet names).

I'd like to enable the user to simply select the folder containing the books and consolidate, rename and alphabetize the sheets.

All in the same module (the CONST) used later, main sub:

Option Explicit
Public Const COMPUTER As String = "C:\"

Public Sub CombineWorkbooks()

    Dim myPath As String
    myPath = UserInputDirectory(COMPUTER)
    If myPath = vbNullString Then
        MsgBox "You cancelled the operation", vbCritical
        Exit Sub
    End If

    Application.DisplayAlerts = False
    Application.EnableEvents = False
    Application.ScreenUpdating = False


    Dim destinationWorkbook As Workbook
    Set destinationWorkbook = Workbooks.Add
    destinationWorkbook.Sheets("Sheet2").Delete
    destinationWorkbook.Sheets("Sheet3").Delete

    Dim sourceWorkbook As Workbook
    Dim sourceWorksheet As Worksheet

    Dim strFilename As String
    strFilename = Dir(myPath &amp; "\*.xls", vbNormal)
    If Len(strFilename) = 0 Then Exit Sub

    Do Until strFilename = ""
        Set sourceWorkbook = Workbooks.Open(Filename:=myPath &amp; "\" &amp; strFilename)
        Set sourceWorksheet = sourceWorkbook.Worksheets(1)
        RenameSheet sourceWorksheet
        sourceWorksheet.Copy After:=destinationWorkbook.Worksheets(destinationWorkbook.Worksheets.Count)
        sourceWorkbook.Close False
        strFilename = Dir()
    Loop
    destinationWorkbook.Sheets("Sheet1").Delete

    Application.DisplayAlerts = True
    Application.EnableEvents = True

    AlphebetizeSheets destinationWorkbook
End Sub


And the supporting cast

Private Sub AlphebetizeSheets(ByVal myBook As Workbook)
    Dim i As Long
    Dim j As Long

    For i = 1 To myBook.Worksheets.Count
        For j = i To myBook.Worksheets.Count
            If UCase(myBook.Sheets(j).Name) &lt; UCase(myBook.Sheets(i).Name) Then
                  myBook.Sheets(j).Move before:=Sheets(i)
             End If
        Next
    Next
    Application.ScreenUpdating = True
    Application.GetSaveAsFilename
End Sub

Private Sub RenameSheet(ByVal targetSheet As Worksheet)
    Dim myParser As Long
    Dim newName As String
    myParser = InStr(1, targetSheet.Name, "(")
    If myParser &gt; 0 Then
        newName = Trim(Left(targetSheet.Name, myParser - 1))
        targetSheet.Name = newName
    End If
End Sub

Private Function UserInputDirectory(ByVal baseDirectory As String) As String
    Dim userFolder As FileDialog
    Dim directoryName As String
    MsgBox "Please select the folder the workbooks are in"
    Set userFolder = Application.FileDialog(msoFileDialogFolderPicker)
    With userFolder
        .Title = "Select a Folder"
        .AllowMultiSelect = False
        .InitialFileName = baseDirectory
        If .Show &lt;&gt; -1 Then GoTo FolderPicked
        directoryName = .SelectedItems(1)
    End With
FolderPicked:
    UserInputDirectory = directoryName
    Set userFolder = Nothing
End Function


I'm sort of worried that there's too much going on in the CombineWorkbooks() sub and that I've missed some errors that may need to be handled.
You've got a spelling mistake; it's "Alphabetize".

Private Sub AlphebetizeSheets(ByVal myBook As Workbook)
    Dim i As Long
    Dim j As Long

    For i = 1 To myBook.Worksheets.Count
        For j = i To myBook.Worksheets.Count
            If UCase(myBook.Sheets(j).Name) &lt; UCase(myBook.Sheets(i).Name) Then
                  myBook.Sheets(j).Move before:=Sheets(i)
             End If
        Next
    Next
    Application.ScreenUpdating = True
    Application.GetSaveAsFilename
End Sub


I thought this is the sort of thing that has been made before...

https://msdn.microsoft.com/en-us/library/office/ff195025.aspx

And it has. But they do it the same way, with two small differences:


They don't compare the sheets with themselves via starting the second for loop at i+1
They don't check the last sheet by stopping i at myBook.Worksheets.Count - 1


Which I guess saves a few comparisons. You've got a weird sorting algorithm here too, a version of selection and insertion sort... which seems to have some flaws, in my opinion.


  8 3 2 6 4 5 1 7
  checks 8, 3, moves 3
  3 8 2 6 4 5 1 7
  checks 2, moves 2
  2 3 8 6 4 5 1 7
  checks 6, 4, 5, 1 moves 1
  1 2 3 8 6 4 5 7
  checks 7, next iteration
  compares 2 to 3, 8, 6, 4, 5, 7, next iteration
  compares 3 to 8, 6, 4, 5, 7, next iteration
  compares 8 to 6, moves 6
  1 2 3 6 8 4 5 7
  compares 6 to 8, 4 moves 4
  1 2 3 4 6 8 5 7
  compares 4 to 5, 7, next iteration
  compares 6 to 8, 5 moves 5
  1 2 3 4 5 6 8 7
  compares 5 to 7, next iteration
  compares 6 to 8, 7, next iteration
  compares 8 to 7, moves 7
  1 2 3 4 5 6 7 8, next iteration and end.  


The problem with this sort is that it compares items[i] with items[i+1] even although on the previous iteration, multiple shifts happened. Take a look at the start:


  8 3 2 6 4 5 1 7
  checks 8, 3, moves 3
  3 8 2 6 4 5 1 7
  checks 2, moves 2
  2 3 8 6 4 5 1 7
  checks 6, 4, 5, 1 moves 1
  1 2 3 8 6 4 5 7
  checks 7, next iteration  


After that, it should know that 2 > 1, 3 > 2, and 8 > 3 so it should skip those.

So instead of 


  compares 2 to 3, 8, 6, 4, 5, 7, next iteration


it should be


  compares 2 to 6, 4, 5, 7, next iteration.


and 


  compares 3 to 6, 4, 5, 7, next iteration.


You could do this by incrementing another variable for every move operation, and decrementing this variable after the j-for loop (with a minimum of 0). Start j at i + this other variable. Like that, it would, after the 3 moves in the first iteration, start the second iteration off at index 4 (i = 2, move counter = 3 - 1 iteration passed = 2).



Alternatively, accept that sorting sheets is likely to be fast already, and don't spend time on this beyond adding the two simple improvements. Maybe store UCase(myBook.Sheets(j).Name) and UCase(myBook.Sheets(i).Name) in temporary variables.