VBA - open all workbooks in a specific order

[biubiubiu]

Hi Guys,

I have a bunch of excel workbooks with names like these :

BOCOM_HK_719286_06260329_P1
BOCOM_HK_719286_06260329_P2
BOCOM_HK_719286_06260329_P3
...
BOCOM_HK_719286_06260329_P11


I need to open these files in the ascending numeric order (p1,p2,p3,p4 etc.)

however, currently the opening order is:
BOCOM_HK_719286_06260329_P1
BOCOM_HK_719286_06260329_P10
BOCOM_HK_719286_06260329_P2
BOCOM_HK_719286_06260329_P20
BOCOM_HK_719286_06260329_P3
BOCOM_HK_719286_06260329_P4
...

The code seems to priortize p10 over p2 and p20 over p3 etc.

What changes should I make to acheived the desired results?

Thanks.

The related section of my code is as follows:

Sub BOCOM()

Dim MyFolder As String
Dim MyFile As String
Dim wb As Workbook

MyFolder = "C:\Users\" & user & "\Desktop\New folder"
MyFile = Dir(MyFolder & "\*.csv")
Do While MyFile <> ""
Set wb = Workbooks.Open(filename:=MyFolder & "\" & MyFile)
wb.Close savechanges:=False

MyFile = Dir
Loop

 

[bobsan42]

well - you don't do any specific sorting - you rely on the system to do it for you.
so it is doing it in the classic alpha numerical way - it sorts the names as strings and doesn't know that the last part is actually a number.

How to Disable Numerical File Name Sorting and Enable Classic Literal Sorting in Windows Explorer? - AskVGWindows

Numerical Sort: Why Numeric File Names are Sorted Differently

I don't know if changing the system setting will change the behaviour of the DIR command.
My preferred way to sort will be to put leading zeros in the filenames themselves.
for example if you expect to have between 10 and 99 files name them like this:
xxxx_xxxx_01
xxxx_xxxx_02
...
xxxx_xxxx_24
...
xxxx_xxxx_99
or if you expect to have more than 100 files:
xxxx_xxxx_001
xxxx_xxxx_002
...
xxxx_xxxx_024
...
xxxx_xxxx_099
xxxx_xxxx_100
...
xxxx_xxxx_386
....
etc.
or to be safe: format the numbers with four digits: 0001 ... 0010 ... 0100 ... 0999 ... 1500 ... 9999
In this way you will be completely independent of the system settings (which may vary on any machine).

 

[wideboydixon]

You'll need to sort the list yourself before opening in order:

Option Compare Text
Sub BOCOM()

Dim MyFolder As String
Dim MyFile As String
Dim MyBooks As New Collection
Dim wb As Workbook
Dim i As Long

MyFolder = "C:\Users\" & user & "\Desktop\New folder"
MyFile = Dir(MyFolder & "\*.csv")

Do While MyFile <> ""
    MyBooks.Add MyFile, MyFile
    MyFile = Dir
Loop

SortCollection MyBooks

For Each MyFile In MyBooks
    Set wb = Workbooks.Open(MyFolder & "\" & MyFile)
    wb.Close SaveChanges:=False
Next

End Sub
Private Sub SortCollection(ByRef myCollection As Collection)

Dim i As Long
Dim j As Long
Dim vTemp As Variant

For i = 1 To myCollection.Count - 1
    For j = i + 1 To myCollection.Count
        If IsBigger(myCollection(i), myCollection(j)) Then
            vTemp = myCollection(j)
            myCollection.Remove j
            myCollection.Add vTemp, vTemp, i
        End If
    Next j
Next i

End Sub
Private Function IsBigger(a As String, b As String) As Boolean

Dim i As Long
Dim j As Long

On Error Resume Next

IsBigger = (a > b)
i = InStrRev(a, "_")
j = InStrRev(b, "_")
If i = 0 Or j = 0 Then Exit Function
If Left$(a, i) <> Left$(b, j) Then Exit Function
Err.Clear
i = CLng(Mid$(a, i + 2))
If Err.Number <> 0 Then Exit Function
j = CLng(Mid$(b, j + 2))
If Err.Number <> 0 Then Exit Function
IsBigger = (i > j)

End Function
Public Sub test()

Dim v As New Collection
Dim t As Variant

v.Add "BOCOM_HK_719286_06260329_P1", "BOCOM_HK_719286_06260329_P1"
v.Add "BOCOM_HK_719286_06260329_P10", "BOCOM_HK_719286_06260329_P10"
v.Add "BOCOM_HK_719286_06260329_P2", "BOCOM_HK_719286_06260329_P2"
v.Add "BOCOM_HK_719286_06260329_P20", "BOCOM_HK_719286_06260329_P20"
v.Add "BOCOM_HK_719286_06260329_P3", "BOCOM_HK_719286_06260329_P3"
v.Add "BOCOM_HK_719286_06260329_P4", "BOCOM_HK_719286_06260329_P4"

SortCollection v

For Each t In v
    Debug.Print t
Next

End Sub

I added the test() sub to quickly test it out. Not that it's a bubble sort so it's not super efficient if you have hundreds of files.

WBD

 

[biubiubiu]

Hi

I tried to implement your code into the originial code I had, but there are some problems:

somehow it keeps telling me that "compile error: for each control variable must be variant or object" - I had to change "dim myfile as string" to "dim myfile as variant" to make it work.

The sorting doesnt seem to work with the new code - it still opens the file in the same order as the orignial code.


As an VBA newbie, I know I must have done something wrong with the code but I can't figure it out, can you please have a look at the code for me please?

the original code:

Sub BOCOM()

Dim K As Long
Dim i As Integer
Dim x1 As String
Dim x2 As String
Dim x3 As Long
Dim x4 As Long
Dim MyFolder As String
Dim MyFile As String
Dim user As String
Dim wb As Workbook
Dim newcell As Long
Dim book1 As Workbook
Dim lastrow As Integer
Dim filename1 As String
Dim filenamelength As Integer

user = InputBox("Your real name in the format as Eddie.W")
filename1 = Dir("C:\Users\" & user & "\Desktop\New folder\" & "*.csv")
filenamelength = Len(filename1) - 6
filename1 = Left(filename1, filenamelength) & "Modified.csv"



Application.ScreenUpdating = False
Application.DisplayAlerts = False




MyFolder = "C:\Users\" & user & "\Desktop\New folder"
MsgBox "All CSV files at" & MyFolder & "will be opened"



MyFile = Dir(MyFolder & "\*.csv")
Set book1 = Workbooks.Open("C:\Users\" & user & "\Desktop\New folder\output\test.csv")


newcell = 2
Do While MyFile <> ""



Set wb = Workbooks.Open(filename:=MyFolder & "\" & MyFile)




lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row



Range("A2:L" & lastrow).Copy
book1.Sheets(1).Range("A" & newcell).PasteSpecial xlPasteValues

newcell = newcell + lastrow - 1


                                          
wb.Close savechanges:=False

MyFile = Dir
Loop

book1.Activate

K = Range("A2").CurrentRegion.Offset(1, 0).Rows.Count
i = 1
Do Until i = K + 1


Cells(i, "L").Value = i

i = i + 1
Loop


book1.Sheets(1).Range("A1").CurrentRegion.Sort Key1:=Range("L1"), _
                                          Header:=xlYes, Order1:=xlDescending
                                          
Columns("L").ClearContents
                                          
                                          
book1.SaveAs filename:=MyFolder & "\" & filename1
book1.Close savechanges:=False

Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

new code:

Sub BOCOM()

Dim K As Long
Dim i As Integer
Dim x1 As String
Dim x2 As String
Dim x3 As Long
Dim x4 As Long
Dim MyFolder As String
Dim MyFile As String
Dim user As String
Dim wb As Workbook
Dim newcell As Long
Dim book1 As Workbook
Dim lastrow As Integer
Dim filename1 As String
Dim filenamelength As Integer
Dim MyBooks As New Collection
Dim z As Long

user = InputBox("Your real name in the format as Eddie.W")
filename1 = Dir("C:\Users\" & user & "\Desktop\New folder\" & "*.csv")
filenamelength = Len(filename1) - 6
filename1 = Left(filename1, filenamelength) & "Modified.csv"

Application.ScreenUpdating = False
Application.DisplayAlerts = False

MyFolder = "C:\Users\" & user & "\Desktop\New folder"
MsgBox "All CSV files at" & MyFolder & "will be opened"

MyFile = Dir(MyFolder & "\*.csv")
Set book1 = Workbooks.Open("C:\Users\" & user & "\Desktop\New folder\output\test.csv")


newcell = 2
Do While MyFile <> ""
    MyBooks.Add MyFile, MyFile
    MyFile = Dir
Loop

SortCollection MyBooks

For Each MyFile In MyBooks
    Set wb = Workbooks.Open(MyFolder & "\" & MyFile)
   


lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row

Range("A2:L" & lastrow).Copy
book1.Sheets(1).Range("A" & newcell).PasteSpecial xlPasteValues

newcell = newcell + lastrow - 1
                                        

 wb.Close SaveChanges:=False
Next


book1.Activate

K = Range("A2").CurrentRegion.Offset(1, 0).Rows.Count
i = 1
Do Until i = K + 1


Cells(i, "L").Value = i

i = i + 1
Loop

book1.Sheets(1).Range("A1").CurrentRegion.Sort Key1:=Range("L1"), _
                                        Header:=xlYes, Order1:=xlDescending
                                       
Columns("L").ClearContents
                                         
book1.SaveAs filename:=MyFolder & "\" & filename1
book1.Close SaveChanges:=False

Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Private Sub SortCollection(ByRef myCollection As Collection)

Dim z As Long
Dim j As Long
Dim vTemp As Variant

For z = 1 To myCollection.Count - 1
    For j = z + 1 To myCollection.Count
        If IsBigger(myCollection(z), myCollection(j)) Then
            vTemp = myCollection(j)
            myCollection.Remove j
            myCollection.Add vTemp, vTemp, z
        End If
    Next j
Next z

End Sub
Private Function IsBigger(a As String, b As String) As Boolean

Dim z As Long
Dim j As Long

On Error Resume Next

IsBigger = (a > b)
z = InStrRev(a, "_")
j = InStrRev(b, "_")
If z = 0 Or j = 0 Then Exit Function
If Left$(a, z) <> Left$(b, j) Then Exit Function
Err.Clear
z = CLng(Mid$(a, z + 2))
If Err.Number <> 0 Then Exit Function
j = CLng(Mid$(b, j + 2))
If Err.Number <> 0 Then Exit Function
IsBigger = (z > j)

End Function

Essentially The code tries to open all the excel workbooks stored at the designated folder and copy the selected range to a new workbook, then reverse its row order and save as a new workbook.


Thanks again

 

[biubiubiu]

Hi bobsan
Since I am using company's computer, I am not allowed to fiddle with registry etc.

But your suggestion in regards to change the name format is very helpful, I have suggested it to my colleagues as a temporary solution.

thanks.

 

[wideboydixon]

I realised that I wasn't accounting for the file extension. Sorry. Here are two updated functions:

Private Sub SortCollection(ByRef myCollection As Collection)

Dim i As Long
Dim j As Long
Dim vTemp As Variant

For i = 1 To myCollection.Count - 1
    For j = i + 1 To myCollection.Count
        If IsBigger(myCollection(i), myCollection(j)) Then
            vTemp = myCollection(j)
            myCollection.Remove j
            myCollection.Add vTemp, vTemp, i
        End If
    Next j
Next i

End Sub
Private Function IsBigger(s1 As String, s2 As String) As Boolean

Dim re As Object
Dim m1 As Object
Dim m2 As Object

' Set up regular expressions
Set re = CreateObject("VBScript.RegExp")
re.Pattern = "(.*_P)([0-9]+)(\..*)"
Set m1 = re.Execute(s1)
Set m2 = re.Execute(s2)

' Default return value
IsBigger = (s1 > s2)

' Check match count
If m1.Count <> 1 Or m2.Count <> 1 Then Exit Function

' Check submatch count
If m1(0).SubMatches.Count <> 3 Or m2(0).SubMatches.Count <> 3 Then Exit Function

' Check start of filename
If StrComp(m1(0).SubMatches(0), m2(0).SubMatches(0), vbTextCompare) <> 0 Then Exit Function

' Finally check numeric value
IsBigger = (CLng(m1(0).SubMatches(1)) > CLng(m2(0).SubMatches(1)))

End Function

WBD

 

[biubiubiu]

Hi WBD

I tried your new code but I dont think its working as intended though, I still need to use "dim myfile as variant"(and i ran the new code against your test(), and it opened file in the wrong oder (p1,p10 then p2 etc.))

I tried to tweak the previous code you gave me, the sorting (sortcollection) definitely works but somehow when I implement the code, it persists to open the file in the wrong order.

Here is the related section of the code

Option Compare Text
Sub BOCOM()

Dim MyFolder As String
Dim MyFile As Variant
Dim MyBooks As New Collection
Dim wb As Workbook
Dim i As Long

MyFolder = "C:\Users\1\Desktop\New folder"
MyFile = Dir(MyFolder & "\*.csv")

Do While MyFile <> ""
    MyBooks.Add MyFile, MyFile
    MyFile = Dir
Loop

SortCollection MyBooks

For Each MyFile In MyBooks
    Set wb = Workbooks.Open(filename:=MyFolder & "\" & MyFile)
    'wb.Close SaveChanges:=False
Next

End Sub

Can you spot anything wrong with the code?

Thanks again

 

[wideboydixon]

Here's my complete code:

Option Compare Text
Sub BOCOM()

Dim MyFolder As String
Dim MyFile As Variant
Dim MyBooks As New Collection

MyFolder = "C:\Sandbox\20160803\"
MyFile = Dir(MyFolder & "*.csv")

Do While MyFile <> ""
    MyBooks.Add MyFile, MyFile
    MyFile = Dir
Loop

SortCollection MyBooks

For Each MyFile In MyBooks
    Debug.Print MyFile
Next

End Sub
Private Sub SortCollection(ByRef myCollection As Collection)

Dim i As Long
Dim j As Long
Dim vTemp As Variant

For i = 1 To myCollection.Count - 1
    For j = i + 1 To myCollection.Count
        If IsBigger(myCollection(i), myCollection(j)) Then
            vTemp = myCollection(j)
            myCollection.Remove j
            myCollection.Add vTemp, vTemp, i
        End If
    Next j
Next i

End Sub
Private Function IsBigger(s1 As String, s2 As String) As Boolean

Dim re As Object
Dim m1 As Object
Dim m2 As Object

' Set up regular expressions
Set re = CreateObject("VBScript.RegExp")
re.Pattern = "(.*_P)([0-9]+)(\..*)"
Set m1 = re.Execute(s1)
Set m2 = re.Execute(s2)

' Default return value
IsBigger = (s1 > s2)

' Check match count
If m1.Count <> 1 Or m2.Count <> 1 Then Exit Function

' Check submatch count
If m1(0).SubMatches.Count <> 3 Or m2(0).SubMatches.Count <> 3 Then Exit Function

' Check start of filename
If StrComp(m1(0).SubMatches(0), m2(0).SubMatches(0), vbTextCompare) <> 0 Then Exit Function

' Finally check numeric value
IsBigger = (CLng(m1(0).SubMatches(1)) > CLng(m2(0).SubMatches(1)))

End Function

Here's the contents of my folder:

C:\Sandbox\20160803\BOCOM_HK_719286_06260329_P1.csv
C:\Sandbox\20160803\BOCOM_HK_719286_06260329_P10.csv
C:\Sandbox\20160803\BOCOM_HK_719286_06260329_P2.csv
C:\Sandbox\20160803\BOCOM_HK_719286_06260329_P20.csv
C:\Sandbox\20160803\BOCOM_HK_719286_06260329_P3.csv
C:\Sandbox\20160803\BOCOM_HK_719286_06260329_P4.csv

And here's the output in the Debug window:

BOCOM_HK_719286_06260329_P1.csv
BOCOM_HK_719286_06260329_P2.csv
BOCOM_HK_719286_06260329_P3.csv
BOCOM_HK_719286_06260329_P4.csv
BOCOM_HK_719286_06260329_P10.csv
BOCOM_HK_719286_06260329_P20.csv

Note that the IsBigger function requires the following:

[1] The file is a CSV file
[2] The first part of the filename ends with "_P" and then a number

I can't help beyond that because I don't have your data and everything is working as expected with my local testing.

WBD

 

[daverunt]

Hi,

I don't have time to write any code but maybe thinking along slightly different lines:

"BOCOM_HK_719286_06260329_P" & X

Do a loop to open workbooks i.e

for X=1 to NumberofFiles

you'd need to check the file exists before trying to open it.

 

[daverunt]

Hi

I've managed to cobble together a bit of code whilst 'at work'

I realised that counting the files in the directory won't work if some numbers are missing so I used a fixed number. It may or may not be practical.
Hopefully it will give you some ideas.

Sub BOCOM()

Dim MyFolder As String
Dim MyFile As String
Dim wb As Workbook


MyFolder = "C:\junk\"
    
     Set fso = CreateObject("Scripting.FileSystemObject")
     
     Set objFiles = fso.GetFolder(MyFolder).Files
     
     'NumFiles = objFiles.Count

 
For x = 1 To 50

WkbNme = "BOCOM_HK_719286_06260329_P" & x & ".csv"

'Check File Exists or Not
If fso.FileExists(MyFolder & WkbNme) Then
Set wb = Workbooks.Open(Filename:=MyFolder & WkbNme)

MsgBox (WkbNme)
wb.Close savechanges:=False
End If
Next


End Sub