VBA Sort DIR to transfer data in alphabetical order

Question

I have written a macro below to copy and paste data from all workbooks within a user selected folder into a master document, however currently the macro selects the files in a random order. What I want to do is for it to select the files in alphabetical order, so the data in the master document is in the correct order... Help achieving this would be much appreciated, I am not precious about the method!

Sub Import_Data()

    ' PURPOSE: To loop through all Excel files in a user specified folder and perform a set task on them

    Dim WB As Workbook
    Dim wbThis As Workbook
    Dim myPath As String
    Dim myFile As String
    Dim myExtension As String
    Dim FldrPicker As FileDialog

    Set wbThis = ActiveWorkbook

    ' Optimize Macro Speed
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual

    ' Retrieve Target Folder Path From User
    MsgBox "Please select Faro Scan Data Folder"

    Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)
    With FldrPicker
        .Title = "Select A Target Folder"
        .AllowMultiSelect = False
        If .Show <> -1 Then GoTo NextCode
        myPath = .SelectedItems(1) & "\"
    End With

    ' In Case of Cancel
NextCode:
    myPath = myPath
    If myPath = "" Then GoTo ResetSettings

    ' Target File Extension (must include wildcard "*")
    myExtension = "*.xls"

    ' Target Path with Ending Extention
    myFile = Dir(myPath & myExtension)

    ' Loop through each Excel file in folder
    Do While myFile <> ""

        ' Set variable equal to opened workbook
        Set WB = Workbooks.Open(Filename:=myPath & myFile)

        ' Ensure Workbook has opened before moving on to next line of code
        DoEvents

        ' Copy data from target workbook....
        WB.Activate
        Application.CutCopyMode = False
        Range("D8:D377").Copy
        wbThis.Activate
        Sheets("Faro Scan Data").Select
        Range("E5").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        Application.CutCopyMode = False

        ' Insert column for next data set
        Columns("E:E").Select
        Selection.Insert Shift:=xlToRight

        ' Format column for new dataset
        Columns("I:I").Select
        Selection.Copy
        Columns("E:E").Select
        Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
        Application.CutCopyMode = False

        ' Close Workbook
        WB.Close SaveChanges:=False

        ' Ensure Workbook has closed before moving on to next line of code
        DoEvents

        ' Get next file name
        myFile = Dir
    Loop

    ' Message Box when tasks are completed
    MsgBox "Task Complete!"

ResetSettings:
    ' Reset Macro Optimization Settings
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

    MsgBox "Remeber to enter column headings!"

End Sub

see this :http://www.vb-helper.com/howto_dir_quicksorted.html — cyboashu, Apr 18 '17 at 16:58
Hi omegastripes, that looks to be what I'm looking for. However I don't see where I should apply it (what references I should change relative to my original attempt etc.) could you perhaps give me some pointers? — dnaylor93, Apr 18 '17 at 20:45

score 1 · Answer 1 · answered Apr 18 '17 at 17:30

1

Take a look at the below example showing how you can loop through files in folder with filter and sorted in alphabetical order using Shell.Application ActiveX:

Option Explicit

Sub Test_Shell_Folder_Items()

    Dim sPath
    Dim sExtension
    Dim oShellApp
    Dim oFolder
    Dim oFolderItems
    Dim oFolderItem

    sPath = "C:\Test"
    sExtension = "*.xls"

    Set oShellApp = CreateObject("Shell.Application")
    Set oFolder = oShellApp.Namespace(sPath)
    Set oFolderItems = oFolder.Items()
    oFolderItems.Filter 64 + 128, sExtension ' 32 - folders, 64 - not folders, 128 - hidden
    For Each oFolderItem In oFolderItems
        Debug.Print oFolderItem.Path
    Next

End Sub

answered Apr 18 '17 at 17:30

omegastripes

12,351
4
45
96

Hi omegastripes, that looks to be what I'm looking for. However I don't see where I should apply it (what references I should change relative to my original attempt etc.) could you perhaps give me some pointers? – dnaylor93 Apr 19 '17 at 07:57
@d_nails_93 you need to implement `For Each ... Next` loop as shown in the example. Modify the example code. Copy the code you have before the line `myExtension = "*.xls"` and paste to the example before the line `sExtension = "*.xls"`, remove `sPath = "C:\Test"` and change to `sPath = .SelectedItems(1)`. Copy the lines you have within `Do ... Loop` and paste to the example into the `For Each ... Next` loop, replace the line `Set WB = Workbooks.Open(Filename:=myPath & myFile)` with `Set WB = Workbooks.Open(Filename:=oFolderItem.Path)`. Use one name instead of `sPath` and `myPath`. – omegastripes May 02 '17 at 17:01

VBA Sort DIR to transfer data in alphabetical order

1 Answers1

Linked