Forcing to load one file before another

M

Matt S

I am importing multiple files into excel based on what a user has selected.
I would like the ability to load the files in the order of the last digit on
the files selected. Right now, I'm pretty sure it's random which one the
code selects. My code is below.

Any help would be appreciated!
Thanks,
Matt


Sub LargeFileImport()

Application.ScreenUpdating = False


'Open Files to run the macro on

Dim ResultStr As String
Dim Counter As Double
Dim varFileList As Variant
Dim lngFileCount As Long
Dim ilngFileNumber As Long
Dim strFileName As String

varFileList = Application.GetOpenFilename(FileFilter:="All Files,
*.*", Title:="Open Runlog File(s)", MultiSelect:=True)

lngFileCount = FileCount(varFileList)

If lngFileCount = 0 Then Exit Function 'User canceled out of dialog box.

'Create A New WorkBook With One Worksheet In It
Workbooks.Add

For ilngFileNumber = 1 To lngFileCount

Runlog_File = CurrentFileName(varFileList, ilngFileNumber)
Open Runlog_File For Input As #ilngFileNumber

'Set The Counter to 1
Counter = 1

If ilngFileNumber = 1 Then
ActiveSheet.Name = "Runlog 1"
FirstSheet = "Runlog 1"
Else
Sheets.Add
ActiveSheet.Name = "Runlog " & Sheets.Count - 2
FirstSheet = "Runlog " & Sheets.Count - 2
Range("AB1").Value = "BASF"
End If

'Loop Until the End Of File Is Reached
Do While Seek(ilngFileNumber) <= LOF(ilngFileNumber)
'Display Importing Row Number On Status Bar
Application.StatusBar = "Importing Row " & _
Counter & " of text file " & Runlog_File
'Store One Line Of Text From File To Variable
Line Input #ilngFileNumber, ResultStr
'Store Variable Data Into Active Cell
If Left(ResultStr, 1) = "=" Then
ActiveCell.Value = "'" & ResultStr
Else
ActiveCell.Value = ResultStr
End If


'For Excel versions before Excel 97, change 65536 to 16384
If ActiveCell.Row = 64008 Then

Columns("A:A").TextToColumns Destination:=Range("A1"),
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False,
Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False,
FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1),
Array(5, 1), Array(6, 1), _
Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1),
Array(11, 1), Array(12, 1), Array(13, 1 _
), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1),
Array(18, 1), Array(19, 1), Array _
(20, 1), Array(21, 1), Array(22, 1), Array(23, 1)),
TrailingMinusNumbers:=True

If Not ActiveSheet.Name = FirstSheet Then
Range("A1:W64008").Cut Destination:=Range("A8:W64015")
CurrentSheet = ActiveSheet.Name
Sheets(FirstSheet).Select
Range("A1:W7").Copy
Sheets(CurrentSheet).Select
Range("A1").PasteSpecial Paste:=xlPasteAll
Else
End If

'Add A New Sheet
Sheets.Add
ActiveSheet.Name = "Runlog " & Sheets.Count - 2
Range("A1").Select

Else
'If Not The Last Row Then Go One Cell Down
ActiveCell.Offset(1, 0).Select
End If
'Increment the Counter By 1
Counter = Counter + 1
'Start Again At Top Of 'Do While' Statement
Loop
'Close The Open Text File
Close
'Remove Message From Status Bar
Application.StatusBar = False


'Format last Runlog sheets's data


Columns("A:A").TextToColumns Destination:=Range("A1"),
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False,
Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False,
FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5,
1), Array(6, 1), _
Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1),
Array(12, 1), Array(13, 1 _
), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18,
1), Array(19, 1), Array _
(20, 1), Array(21, 1), Array(22, 1), Array(23, 1)),
TrailingMinusNumbers:=True

Range("A1:W64008").Cut Destination:=Range("A8:W64015")
CurrentSheet = ActiveSheet.Name
Sheets(FirstSheet).Select
Range("A1:W7").Copy
Sheets(CurrentSheet).Select
Range("A1").PasteSpecial Paste:=xlPasteAll

Next

Sheets("Runlog 1").Select



'Fix Timing values to increment between files

For k = 1 To Sheets.Count - 2

Sheets("Runlog " & k).Select

If Range("AB1").Value = "BASF" Then

Sheets("Runlog " & k - 1).Select
Range("A8").Select
Selection.End(xlDown).Select
EndTime = ActiveCell.Value

For j = k To Sheets.Count - 2
Sheets("Runlog " & j).Select

LastRow = Cells(Rows.Count, "A").End(xlUp).Row
Columns("B:B").Insert Shift:=xlToRight
Range("B8").FormulaR1C1 = "=RC[-1]+" & EndTime
Range("B8").AutoFill Destination:=Range("B8:B" & LastRow)
Range("B8:B" & LastRow).Copy
Range("A8:A" & LastRow).PasteSpecial Paste:=xlPasteValues
Columns("B:B").Delete Shift:=xlToLeft

If j + 1 < Sheets.Count - 2 Then
If Sheets("Runlog " & j + 1).Range("AB1").Value = "BASF"
Then Exit For
End If

Next

End If

Next

End Function


Private Function FileCount(varFileList) As Long
Select Case VarType(varFileList)
Case vbBoolean
'User canceled out of the File Open dialog box.
FileCount = 0
Case vbString
'Dialog box is in single file mode.
'Single file selected for opening only.
FileCount = 1
Case vbArray + vbVariant
'Multiple files selected for processing.
FileCount = UBound(varFileList) - LBound(varFileList) + 1
End Select
End Function

Private Function CurrentFileName(varFileList As Variant, _
ilngFileNumber As Long) As String

Select Case VarType(varFileList)
Case vbBoolean
'User canceled out of the File Open dialog box.
CurrentFileName = ""
Case vbString
'Dialog box is in single file mode.
'Single file selected for opening only.
CurrentFileName = varFileList
Case vbArray + vbVariant
'Multiple files selected for processing.
'Return the filename currently pointed to.
CurrentFileName = CStr(varFileList(ilngFileNumber))
End Select
End Function
 
B

Bernie Deitrick

Matt,

You can create a 2D array of the filenames and the last digit to bubble sort based on the last
digit.

I have assumed that character to be just before the . in the file name - I've also assumed that
there is only one . in the filename.

See the example code below.

HTH,
Bernie
MS Excel MVP


Sub BubbleSortFilenames()
Dim myArray() As String
Dim myTemp1 As String
Dim myTemp2 As String
Dim i As Integer
Dim j As Integer

Dim FileArray As Variant

FileArray = Application.GetOpenFilename(FileFilter:="All Files, *.*", _
Title:="Open Runlog File(s)", MultiSelect:=True)

If IsArray(FileArray) Then
ReDim myArray(1 To UBound(FileArray) - LBound(FileArray) + 1, 1 To 2) As String

For i = LBound(FileArray) To UBound(FileArray)
myArray(i, 1) = FileArray(i)
myArray(i, 2) = Right(Left(FileArray(i), InStr(1, FileArray(i), ".") - 1), 1)
Next i


For i = LBound(myArray, 1) To UBound(myArray, 1) - 1
For j = i + 1 To UBound(myArray, 1)
If myArray(i, 2) > myArray(j, 2) Then
myTemp1 = myArray(j, 1)
myTemp2 = myArray(j, 2)
myArray(j, 1) = myArray(i, 1)
myArray(j, 2) = myArray(i, 2)
myArray(i, 1) = myTemp1
myArray(i, 2) = myTemp2
End If
Next j
Next i

'The file array is now sorted on the last character before
'the .xls part of the file name
For i = LBound(myArray, 1) To UBound(myArray, 1)
MsgBox myArray(i, 1)
'************************************************
'Process the file by using FileArray(i) here
'For Example - Workbooks.Open FileArray(i)
'*************************************************
Next i
Else:
MsgBox "You clicked cancel"
End If

End Sub


Matt S said:
I am importing multiple files into excel based on what a user has selected.
I would like the ability to load the files in the order of the last digit on
the files selected. Right now, I'm pretty sure it's random which one the
code selects. My code is below.

Any help would be appreciated!
Thanks,
Matt


Sub LargeFileImport()

Application.ScreenUpdating = False


'Open Files to run the macro on

Dim ResultStr As String
Dim Counter As Double
Dim varFileList As Variant
Dim lngFileCount As Long
Dim ilngFileNumber As Long
Dim strFileName As String

varFileList = Application.GetOpenFilename(FileFilter:="All Files,
*.*", Title:="Open Runlog File(s)", MultiSelect:=True)

lngFileCount = FileCount(varFileList)

If lngFileCount = 0 Then Exit Function 'User canceled out of dialog box.

'Create A New WorkBook With One Worksheet In It
Workbooks.Add

For ilngFileNumber = 1 To lngFileCount

Runlog_File = CurrentFileName(varFileList, ilngFileNumber)
Open Runlog_File For Input As #ilngFileNumber

'Set The Counter to 1
Counter = 1

If ilngFileNumber = 1 Then
ActiveSheet.Name = "Runlog 1"
FirstSheet = "Runlog 1"
Else
Sheets.Add
ActiveSheet.Name = "Runlog " & Sheets.Count - 2
FirstSheet = "Runlog " & Sheets.Count - 2
Range("AB1").Value = "BASF"
End If

'Loop Until the End Of File Is Reached
Do While Seek(ilngFileNumber) <= LOF(ilngFileNumber)
'Display Importing Row Number On Status Bar
Application.StatusBar = "Importing Row " & _
Counter & " of text file " & Runlog_File
'Store One Line Of Text From File To Variable
Line Input #ilngFileNumber, ResultStr
'Store Variable Data Into Active Cell
If Left(ResultStr, 1) = "=" Then
ActiveCell.Value = "'" & ResultStr
Else
ActiveCell.Value = ResultStr
End If


'For Excel versions before Excel 97, change 65536 to 16384
If ActiveCell.Row = 64008 Then

Columns("A:A").TextToColumns Destination:=Range("A1"),
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False,
Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False,
FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1),
Array(5, 1), Array(6, 1), _
Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1),
Array(11, 1), Array(12, 1), Array(13, 1 _
), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1),
Array(18, 1), Array(19, 1), Array _
(20, 1), Array(21, 1), Array(22, 1), Array(23, 1)),
TrailingMinusNumbers:=True

If Not ActiveSheet.Name = FirstSheet Then
Range("A1:W64008").Cut Destination:=Range("A8:W64015")
CurrentSheet = ActiveSheet.Name
Sheets(FirstSheet).Select
Range("A1:W7").Copy
Sheets(CurrentSheet).Select
Range("A1").PasteSpecial Paste:=xlPasteAll
Else
End If

'Add A New Sheet
Sheets.Add
ActiveSheet.Name = "Runlog " & Sheets.Count - 2
Range("A1").Select

Else
'If Not The Last Row Then Go One Cell Down
ActiveCell.Offset(1, 0).Select
End If
'Increment the Counter By 1
Counter = Counter + 1
'Start Again At Top Of 'Do While' Statement
Loop
'Close The Open Text File
Close
'Remove Message From Status Bar
Application.StatusBar = False


'Format last Runlog sheets's data


Columns("A:A").TextToColumns Destination:=Range("A1"),
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False,
Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False,
FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5,
1), Array(6, 1), _
Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1),
Array(12, 1), Array(13, 1 _
), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18,
1), Array(19, 1), Array _
(20, 1), Array(21, 1), Array(22, 1), Array(23, 1)),
TrailingMinusNumbers:=True

Range("A1:W64008").Cut Destination:=Range("A8:W64015")
CurrentSheet = ActiveSheet.Name
Sheets(FirstSheet).Select
Range("A1:W7").Copy
Sheets(CurrentSheet).Select
Range("A1").PasteSpecial Paste:=xlPasteAll

Next

Sheets("Runlog 1").Select



'Fix Timing values to increment between files

For k = 1 To Sheets.Count - 2

Sheets("Runlog " & k).Select

If Range("AB1").Value = "BASF" Then

Sheets("Runlog " & k - 1).Select
Range("A8").Select
Selection.End(xlDown).Select
EndTime = ActiveCell.Value

For j = k To Sheets.Count - 2
Sheets("Runlog " & j).Select

LastRow = Cells(Rows.Count, "A").End(xlUp).Row
Columns("B:B").Insert Shift:=xlToRight
Range("B8").FormulaR1C1 = "=RC[-1]+" & EndTime
Range("B8").AutoFill Destination:=Range("B8:B" & LastRow)
Range("B8:B" & LastRow).Copy
Range("A8:A" & LastRow).PasteSpecial Paste:=xlPasteValues
Columns("B:B").Delete Shift:=xlToLeft

If j + 1 < Sheets.Count - 2 Then
If Sheets("Runlog " & j + 1).Range("AB1").Value = "BASF"
Then Exit For
End If

Next

End If

Next

End Function


Private Function FileCount(varFileList) As Long
Select Case VarType(varFileList)
Case vbBoolean
'User canceled out of the File Open dialog box.
FileCount = 0
Case vbString
'Dialog box is in single file mode.
'Single file selected for opening only.
FileCount = 1
Case vbArray + vbVariant
'Multiple files selected for processing.
FileCount = UBound(varFileList) - LBound(varFileList) + 1
End Select
End Function

Private Function CurrentFileName(varFileList As Variant, _
ilngFileNumber As Long) As String

Select Case VarType(varFileList)
Case vbBoolean
'User canceled out of the File Open dialog box.
CurrentFileName = ""
Case vbString
'Dialog box is in single file mode.
'Single file selected for opening only.
CurrentFileName = varFileList
Case vbArray + vbVariant
'Multiple files selected for processing.
'Return the filename currently pointed to.
CurrentFileName = CStr(varFileList(ilngFileNumber))
End Select
End Function
Click to expand...
 
J

Joel

Add the one line below to code and then add New Subroutine below. I'm
sorting on the one character before the period in the filename. I assume the
extension of the file names are all the same.

lngFileCount = FileCount(varFileList)

If lngFileCount = 0 Then Exit Function 'User canceled out of dialog box.
call SortVarList(varFileList) '<=Add New Line

'Create A New WorkBook With One Worksheet In It
Workbooks.Add


Add New subroutine

Private Sub SortVarList(ByRef varFileList)
For i = LBound(varFileList) To (UBound(varFileList) - 2)
ISort = Mid(varFileList(i), _
InStr(varFileList(i), ".") - 1, 1)
For j = (i + 1) To (UBound(varFileList) - 1)
JSort = Mid(varFileList(j), _
InStr(varFileList(j), ".") - 1, 1)
If Asc(JSort) < Asc(ISort) Then
Temp = varFileList(i)
varFileList(i) = varFileList(j)
varFileList(j) = Temp

Temp = ISort
ISort = JSort
JSort = Temp
End If
Next j
Next i
End Sub


Matt S said:
I am importing multiple files into excel based on what a user has selected.
I would like the ability to load the files in the order of the last digit on
the files selected. Right now, I'm pretty sure it's random which one the
code selects. My code is below.

Any help would be appreciated!
Thanks,
Matt


Sub LargeFileImport()

Application.ScreenUpdating = False


'Open Files to run the macro on

Dim ResultStr As String
Dim Counter As Double
Dim varFileList As Variant
Dim lngFileCount As Long
Dim ilngFileNumber As Long
Dim strFileName As String

varFileList = Application.GetOpenFilename(FileFilter:="All Files,
*.*", Title:="Open Runlog File(s)", MultiSelect:=True)

lngFileCount = FileCount(varFileList)

If lngFileCount = 0 Then Exit Function 'User canceled out of dialog box.

'Create A New WorkBook With One Worksheet In It
Workbooks.Add

For ilngFileNumber = 1 To lngFileCount

Runlog_File = CurrentFileName(varFileList, ilngFileNumber)
Open Runlog_File For Input As #ilngFileNumber

'Set The Counter to 1
Counter = 1

If ilngFileNumber = 1 Then
ActiveSheet.Name = "Runlog 1"
FirstSheet = "Runlog 1"
Else
Sheets.Add
ActiveSheet.Name = "Runlog " & Sheets.Count - 2
FirstSheet = "Runlog " & Sheets.Count - 2
Range("AB1").Value = "BASF"
End If

'Loop Until the End Of File Is Reached
Do While Seek(ilngFileNumber) <= LOF(ilngFileNumber)
'Display Importing Row Number On Status Bar
Application.StatusBar = "Importing Row " & _
Counter & " of text file " & Runlog_File
'Store One Line Of Text From File To Variable
Line Input #ilngFileNumber, ResultStr
'Store Variable Data Into Active Cell
If Left(ResultStr, 1) = "=" Then
ActiveCell.Value = "'" & ResultStr
Else
ActiveCell.Value = ResultStr
End If


'For Excel versions before Excel 97, change 65536 to 16384
If ActiveCell.Row = 64008 Then

Columns("A:A").TextToColumns Destination:=Range("A1"),
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False,
Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False,
FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1),
Array(5, 1), Array(6, 1), _
Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1),
Array(11, 1), Array(12, 1), Array(13, 1 _
), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1),
Array(18, 1), Array(19, 1), Array _
(20, 1), Array(21, 1), Array(22, 1), Array(23, 1)),
TrailingMinusNumbers:=True

If Not ActiveSheet.Name = FirstSheet Then
Range("A1:W64008").Cut Destination:=Range("A8:W64015")
CurrentSheet = ActiveSheet.Name
Sheets(FirstSheet).Select
Range("A1:W7").Copy
Sheets(CurrentSheet).Select
Range("A1").PasteSpecial Paste:=xlPasteAll
Else
End If

'Add A New Sheet
Sheets.Add
ActiveSheet.Name = "Runlog " & Sheets.Count - 2
Range("A1").Select

Else
'If Not The Last Row Then Go One Cell Down
ActiveCell.Offset(1, 0).Select
End If
'Increment the Counter By 1
Counter = Counter + 1
'Start Again At Top Of 'Do While' Statement
Loop
'Close The Open Text File
Close
'Remove Message From Status Bar
Application.StatusBar = False


'Format last Runlog sheets's data


Columns("A:A").TextToColumns Destination:=Range("A1"),
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False,
Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False,
FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5,
1), Array(6, 1), _
Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1),
Array(12, 1), Array(13, 1 _
), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18,
1), Array(19, 1), Array _
(20, 1), Array(21, 1), Array(22, 1), Array(23, 1)),
TrailingMinusNumbers:=True

Range("A1:W64008").Cut Destination:=Range("A8:W64015")
CurrentSheet = ActiveSheet.Name
Sheets(FirstSheet).Select
Range("A1:W7").Copy
Sheets(CurrentSheet).Select
Range("A1").PasteSpecial Paste:=xlPasteAll

Next

Sheets("Runlog 1").Select



'Fix Timing values to increment between files

For k = 1 To Sheets.Count - 2

Sheets("Runlog " & k).Select

If Range("AB1").Value = "BASF" Then

Sheets("Runlog " & k - 1).Select
Range("A8").Select
Selection.End(xlDown).Select
EndTime = ActiveCell.Value

For j = k To Sheets.Count - 2
Sheets("Runlog " & j).Select

LastRow = Cells(Rows.Count, "A").End(xlUp).Row
Columns("B:B").Insert Shift:=xlToRight
Range("B8").FormulaR1C1 = "=RC[-1]+" & EndTime
Range("B8").AutoFill Destination:=Range("B8:B" & LastRow)
Range("B8:B" & LastRow).Copy
Range("A8:A" & LastRow).PasteSpecial Paste:=xlPasteValues
Columns("B:B").Delete Shift:=xlToLeft

If j + 1 < Sheets.Count - 2 Then
If Sheets("Runlog " & j + 1).Range("AB1").Value = "BASF"
Then Exit For
End If

Next

End If

Next

End Function


Private Function FileCount(varFileList) As Long
Select Case VarType(varFileList)
Case vbBoolean
'User canceled out of the File Open dialog box.
FileCount = 0
Case vbString
'Dialog box is in single file mode.
'Single file selected for opening only.
FileCount = 1
Case vbArray + vbVariant
'Multiple files selected for processing.
FileCount = UBound(varFileList) - LBound(varFileList) + 1
End Select
End Function

Private Function CurrentFileName(varFileList As Variant, _
ilngFileNumber As Long) As String

Select Case VarType(varFileList)
Case vbBoolean
'User canceled out of the File Open dialog box.
CurrentFileName = ""
Case vbString
'Dialog box is in single file mode.
'Single file selected for opening only.
CurrentFileName = varFileList
Case vbArray + vbVariant
'Multiple files selected for processing.
'Return the filename currently pointed to.
CurrentFileName = CStr(varFileList(ilngFileNumber))
End Select
End Function
Click to expand...
 
B

Bernie Deitrick

Oops - I messed up the example

The code example:
'Process the file by using FileArray(i) here
'For Example - Workbooks.Open FileArray(i)

Should have been:
'Process the file by using myArray(i, 1) here
'For Example - Workbooks.Open myArray(i, 1)

HTH,
Bernie
MS Excel MVP


Bernie Deitrick said:
Matt,

You can create a 2D array of the filenames and the last digit to bubble sort based on the last
digit.

I have assumed that character to be just before the . in the file name - I've also assumed that
there is only one . in the filename.

See the example code below.

HTH,
Bernie
MS Excel MVP


Sub BubbleSortFilenames()
Dim myArray() As String
Dim myTemp1 As String
Dim myTemp2 As String
Dim i As Integer
Dim j As Integer

Dim FileArray As Variant

FileArray = Application.GetOpenFilename(FileFilter:="All Files, *.*", _
Title:="Open Runlog File(s)", MultiSelect:=True)

If IsArray(FileArray) Then
ReDim myArray(1 To UBound(FileArray) - LBound(FileArray) + 1, 1 To 2) As String

For i = LBound(FileArray) To UBound(FileArray)
myArray(i, 1) = FileArray(i)
myArray(i, 2) = Right(Left(FileArray(i), InStr(1, FileArray(i), ".") - 1), 1)
Next i


For i = LBound(myArray, 1) To UBound(myArray, 1) - 1
For j = i + 1 To UBound(myArray, 1)
If myArray(i, 2) > myArray(j, 2) Then
myTemp1 = myArray(j, 1)
myTemp2 = myArray(j, 2)
myArray(j, 1) = myArray(i, 1)
myArray(j, 2) = myArray(i, 2)
myArray(i, 1) = myTemp1
myArray(i, 2) = myTemp2
End If
Next j
Next i

'The file array is now sorted on the last character before
'the .xls part of the file name
For i = LBound(myArray, 1) To UBound(myArray, 1)
MsgBox myArray(i, 1)
'************************************************
'Process the file by using FileArray(i) here
'For Example - Workbooks.Open FileArray(i)
'*************************************************
Next i
Else:
MsgBox "You clicked cancel"
End If

End Sub


Matt S said:
I am importing multiple files into excel based on what a user has selected.
I would like the ability to load the files in the order of the last digit on
the files selected. Right now, I'm pretty sure it's random which one the
code selects. My code is below.

Any help would be appreciated!
Thanks,
Matt


Sub LargeFileImport()

Application.ScreenUpdating = False


'Open Files to run the macro on

Dim ResultStr As String
Dim Counter As Double
Dim varFileList As Variant
Dim lngFileCount As Long
Dim ilngFileNumber As Long
Dim strFileName As String

varFileList = Application.GetOpenFilename(FileFilter:="All Files,
*.*", Title:="Open Runlog File(s)", MultiSelect:=True)

lngFileCount = FileCount(varFileList)

If lngFileCount = 0 Then Exit Function 'User canceled out of dialog box.

'Create A New WorkBook With One Worksheet In It
Workbooks.Add

For ilngFileNumber = 1 To lngFileCount

Runlog_File = CurrentFileName(varFileList, ilngFileNumber)
Open Runlog_File For Input As #ilngFileNumber

'Set The Counter to 1
Counter = 1

If ilngFileNumber = 1 Then
ActiveSheet.Name = "Runlog 1"
FirstSheet = "Runlog 1"
Else
Sheets.Add
ActiveSheet.Name = "Runlog " & Sheets.Count - 2
FirstSheet = "Runlog " & Sheets.Count - 2
Range("AB1").Value = "BASF"
End If

'Loop Until the End Of File Is Reached
Do While Seek(ilngFileNumber) <= LOF(ilngFileNumber)
'Display Importing Row Number On Status Bar
Application.StatusBar = "Importing Row " & _
Counter & " of text file " & Runlog_File
'Store One Line Of Text From File To Variable
Line Input #ilngFileNumber, ResultStr
'Store Variable Data Into Active Cell
If Left(ResultStr, 1) = "=" Then
ActiveCell.Value = "'" & ResultStr
Else
ActiveCell.Value = ResultStr
End If


'For Excel versions before Excel 97, change 65536 to 16384
If ActiveCell.Row = 64008 Then

Columns("A:A").TextToColumns Destination:=Range("A1"),
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False,
Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False,
FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1),
Array(5, 1), Array(6, 1), _
Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1),
Array(11, 1), Array(12, 1), Array(13, 1 _
), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1),
Array(18, 1), Array(19, 1), Array _
(20, 1), Array(21, 1), Array(22, 1), Array(23, 1)),
TrailingMinusNumbers:=True

If Not ActiveSheet.Name = FirstSheet Then
Range("A1:W64008").Cut Destination:=Range("A8:W64015")
CurrentSheet = ActiveSheet.Name
Sheets(FirstSheet).Select
Range("A1:W7").Copy
Sheets(CurrentSheet).Select
Range("A1").PasteSpecial Paste:=xlPasteAll
Else
End If

'Add A New Sheet
Sheets.Add
ActiveSheet.Name = "Runlog " & Sheets.Count - 2
Range("A1").Select

Else
'If Not The Last Row Then Go One Cell Down
ActiveCell.Offset(1, 0).Select
End If
'Increment the Counter By 1
Counter = Counter + 1
'Start Again At Top Of 'Do While' Statement
Loop
'Close The Open Text File
Close
'Remove Message From Status Bar
Application.StatusBar = False


'Format last Runlog sheets's data


Columns("A:A").TextToColumns Destination:=Range("A1"),
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False,
Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False,
FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5,
1), Array(6, 1), _
Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1),
Array(12, 1), Array(13, 1 _
), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18,
1), Array(19, 1), Array _
(20, 1), Array(21, 1), Array(22, 1), Array(23, 1)),
TrailingMinusNumbers:=True

Range("A1:W64008").Cut Destination:=Range("A8:W64015")
CurrentSheet = ActiveSheet.Name
Sheets(FirstSheet).Select
Range("A1:W7").Copy
Sheets(CurrentSheet).Select
Range("A1").PasteSpecial Paste:=xlPasteAll

Next

Sheets("Runlog 1").Select



'Fix Timing values to increment between files

For k = 1 To Sheets.Count - 2

Sheets("Runlog " & k).Select

If Range("AB1").Value = "BASF" Then

Sheets("Runlog " & k - 1).Select
Range("A8").Select
Selection.End(xlDown).Select
EndTime = ActiveCell.Value

For j = k To Sheets.Count - 2
Sheets("Runlog " & j).Select

LastRow = Cells(Rows.Count, "A").End(xlUp).Row
Columns("B:B").Insert Shift:=xlToRight
Range("B8").FormulaR1C1 = "=RC[-1]+" & EndTime
Range("B8").AutoFill Destination:=Range("B8:B" & LastRow)
Range("B8:B" & LastRow).Copy
Range("A8:A" & LastRow).PasteSpecial Paste:=xlPasteValues
Columns("B:B").Delete Shift:=xlToLeft

If j + 1 < Sheets.Count - 2 Then
If Sheets("Runlog " & j + 1).Range("AB1").Value = "BASF"
Then Exit For
End If

Next

End If

Next

End Function


Private Function FileCount(varFileList) As Long
Select Case VarType(varFileList)
Case vbBoolean
'User canceled out of the File Open dialog box.
FileCount = 0
Case vbString
'Dialog box is in single file mode.
'Single file selected for opening only.
FileCount = 1
Case vbArray + vbVariant
'Multiple files selected for processing.
FileCount = UBound(varFileList) - LBound(varFileList) + 1
End Select
End Function

Private Function CurrentFileName(varFileList As Variant, _
ilngFileNumber As Long) As String

Select Case VarType(varFileList)
Case vbBoolean
'User canceled out of the File Open dialog box.
CurrentFileName = ""
Case vbString
'Dialog box is in single file mode.
'Single file selected for opening only.
CurrentFileName = varFileList
Case vbArray + vbVariant
'Multiple files selected for processing.
'Return the filename currently pointed to.
CurrentFileName = CStr(varFileList(ilngFileNumber))
End Select
End Function
Click to expand...
Click to expand...
 
M

Matt S

Joel,

Is your code only organizing two files? I loaded three files and the order
went 1, 3, 2.

Let me try Bernie's code and I'll get back to you.

Thanks,
Matt

Joel said:
Add the one line below to code and then add New Subroutine below. I'm
sorting on the one character before the period in the filename. I assume the
extension of the file names are all the same.

lngFileCount = FileCount(varFileList)

If lngFileCount = 0 Then Exit Function 'User canceled out of dialog box.
call SortVarList(varFileList) '<=Add New Line

'Create A New WorkBook With One Worksheet In It
Workbooks.Add


Add New subroutine

Private Sub SortVarList(ByRef varFileList)
For i = LBound(varFileList) To (UBound(varFileList) - 2)
ISort = Mid(varFileList(i), _
InStr(varFileList(i), ".") - 1, 1)
For j = (i + 1) To (UBound(varFileList) - 1)
JSort = Mid(varFileList(j), _
InStr(varFileList(j), ".") - 1, 1)
If Asc(JSort) < Asc(ISort) Then
Temp = varFileList(i)
varFileList(i) = varFileList(j)
varFileList(j) = Temp

Temp = ISort
ISort = JSort
JSort = Temp
End If
Next j
Next i
End Sub


Matt S said:
I am importing multiple files into excel based on what a user has selected.
I would like the ability to load the files in the order of the last digit on
the files selected. Right now, I'm pretty sure it's random which one the
code selects. My code is below.

Any help would be appreciated!
Thanks,
Matt


Sub LargeFileImport()

Application.ScreenUpdating = False


'Open Files to run the macro on

Dim ResultStr As String
Dim Counter As Double
Dim varFileList As Variant
Dim lngFileCount As Long
Dim ilngFileNumber As Long
Dim strFileName As String

varFileList = Application.GetOpenFilename(FileFilter:="All Files,
*.*", Title:="Open Runlog File(s)", MultiSelect:=True)

lngFileCount = FileCount(varFileList)

If lngFileCount = 0 Then Exit Function 'User canceled out of dialog box.

'Create A New WorkBook With One Worksheet In It
Workbooks.Add

For ilngFileNumber = 1 To lngFileCount

Runlog_File = CurrentFileName(varFileList, ilngFileNumber)
Open Runlog_File For Input As #ilngFileNumber

'Set The Counter to 1
Counter = 1

If ilngFileNumber = 1 Then
ActiveSheet.Name = "Runlog 1"
FirstSheet = "Runlog 1"
Else
Sheets.Add
ActiveSheet.Name = "Runlog " & Sheets.Count - 2
FirstSheet = "Runlog " & Sheets.Count - 2
Range("AB1").Value = "BASF"
End If

'Loop Until the End Of File Is Reached
Do While Seek(ilngFileNumber) <= LOF(ilngFileNumber)
'Display Importing Row Number On Status Bar
Application.StatusBar = "Importing Row " & _
Counter & " of text file " & Runlog_File
'Store One Line Of Text From File To Variable
Line Input #ilngFileNumber, ResultStr
'Store Variable Data Into Active Cell
If Left(ResultStr, 1) = "=" Then
ActiveCell.Value = "'" & ResultStr
Else
ActiveCell.Value = ResultStr
End If


'For Excel versions before Excel 97, change 65536 to 16384
If ActiveCell.Row = 64008 Then

Columns("A:A").TextToColumns Destination:=Range("A1"),
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False,
Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False,
FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1),
Array(5, 1), Array(6, 1), _
Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1),
Array(11, 1), Array(12, 1), Array(13, 1 _
), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1),
Array(18, 1), Array(19, 1), Array _
(20, 1), Array(21, 1), Array(22, 1), Array(23, 1)),
TrailingMinusNumbers:=True

If Not ActiveSheet.Name = FirstSheet Then
Range("A1:W64008").Cut Destination:=Range("A8:W64015")
CurrentSheet = ActiveSheet.Name
Sheets(FirstSheet).Select
Range("A1:W7").Copy
Sheets(CurrentSheet).Select
Range("A1").PasteSpecial Paste:=xlPasteAll
Else
End If

'Add A New Sheet
Sheets.Add
ActiveSheet.Name = "Runlog " & Sheets.Count - 2
Range("A1").Select

Else
'If Not The Last Row Then Go One Cell Down
ActiveCell.Offset(1, 0).Select
End If
'Increment the Counter By 1
Counter = Counter + 1
'Start Again At Top Of 'Do While' Statement
Loop
'Close The Open Text File
Close
'Remove Message From Status Bar
Application.StatusBar = False


'Format last Runlog sheets's data


Columns("A:A").TextToColumns Destination:=Range("A1"),
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False,
Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False,
FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5,
1), Array(6, 1), _
Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1),
Array(12, 1), Array(13, 1 _
), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18,
1), Array(19, 1), Array _
(20, 1), Array(21, 1), Array(22, 1), Array(23, 1)),
TrailingMinusNumbers:=True

Range("A1:W64008").Cut Destination:=Range("A8:W64015")
CurrentSheet = ActiveSheet.Name
Sheets(FirstSheet).Select
Range("A1:W7").Copy
Sheets(CurrentSheet).Select
Range("A1").PasteSpecial Paste:=xlPasteAll

Next

Sheets("Runlog 1").Select



'Fix Timing values to increment between files

For k = 1 To Sheets.Count - 2

Sheets("Runlog " & k).Select

If Range("AB1").Value = "BASF" Then

Sheets("Runlog " & k - 1).Select
Range("A8").Select
Selection.End(xlDown).Select
EndTime = ActiveCell.Value

For j = k To Sheets.Count - 2
Sheets("Runlog " & j).Select

LastRow = Cells(Rows.Count, "A").End(xlUp).Row
Columns("B:B").Insert Shift:=xlToRight
Range("B8").FormulaR1C1 = "=RC[-1]+" & EndTime
Range("B8").AutoFill Destination:=Range("B8:B" & LastRow)
Range("B8:B" & LastRow).Copy
Range("A8:A" & LastRow).PasteSpecial Paste:=xlPasteValues
Columns("B:B").Delete Shift:=xlToLeft

If j + 1 < Sheets.Count - 2 Then
If Sheets("Runlog " & j + 1).Range("AB1").Value = "BASF"
Then Exit For
End If

Next

End If

Next

End Function


Private Function FileCount(varFileList) As Long
Select Case VarType(varFileList)
Case vbBoolean
'User canceled out of the File Open dialog box.
FileCount = 0
Case vbString
'Dialog box is in single file mode.
'Single file selected for opening only.
FileCount = 1
Case vbArray + vbVariant
'Multiple files selected for processing.
FileCount = UBound(varFileList) - LBound(varFileList) + 1
End Select
End Function

Private Function CurrentFileName(varFileList As Variant, _
ilngFileNumber As Long) As String

Select Case VarType(varFileList)
Case vbBoolean
'User canceled out of the File Open dialog box.
CurrentFileName = ""
Case vbString
'Dialog box is in single file mode.
'Single file selected for opening only.
CurrentFileName = varFileList
Case vbArray + vbVariant
'Multiple files selected for processing.
'Return the filename currently pointed to.
CurrentFileName = CStr(varFileList(ilngFileNumber))
End Select
End Function
Click to expand...
Click to expand...
 
J

Joel

Whoops. My loop counters are wrong

from
For i = LBound(varFileList) To (UBound(varFileList) - 2)
ISort = Mid(varFileList(i), _
InStr(varFileList(i), ".") - 1, 1)
For j = (i + 1) To (UBound(varFileList) - 1)

to
For i = LBound(varFileList) To (UBound(varFileList) - 1)
ISort = Mid(varFileList(i), _
InStr(varFileList(i), ".") - 1, 1)
For j = (i + 1) To UBound(varFileList)

Matt S said:
Joel,

Is your code only organizing two files? I loaded three files and the order
went 1, 3, 2.

Let me try Bernie's code and I'll get back to you.

Thanks,
Matt

Joel said:
Add the one line below to code and then add New Subroutine below. I'm
sorting on the one character before the period in the filename. I assume the
extension of the file names are all the same.

lngFileCount = FileCount(varFileList)

If lngFileCount = 0 Then Exit Function 'User canceled out of dialog box.
call SortVarList(varFileList) '<=Add New Line

'Create A New WorkBook With One Worksheet In It
Workbooks.Add


Add New subroutine

Private Sub SortVarList(ByRef varFileList)
For i = LBound(varFileList) To (UBound(varFileList) - 2)
ISort = Mid(varFileList(i), _
InStr(varFileList(i), ".") - 1, 1)
For j = (i + 1) To (UBound(varFileList) - 1)
JSort = Mid(varFileList(j), _
InStr(varFileList(j), ".") - 1, 1)
If Asc(JSort) < Asc(ISort) Then
Temp = varFileList(i)
varFileList(i) = varFileList(j)
varFileList(j) = Temp

Temp = ISort
ISort = JSort
JSort = Temp
End If
Next j
Next i
End Sub


Matt S said:
I am importing multiple files into excel based on what a user has selected.
I would like the ability to load the files in the order of the last digit on
the files selected. Right now, I'm pretty sure it's random which one the
code selects. My code is below.

Any help would be appreciated!
Thanks,
Matt


Sub LargeFileImport()

Application.ScreenUpdating = False


'Open Files to run the macro on

Dim ResultStr As String
Dim Counter As Double
Dim varFileList As Variant
Dim lngFileCount As Long
Dim ilngFileNumber As Long
Dim strFileName As String

varFileList = Application.GetOpenFilename(FileFilter:="All Files,
*.*", Title:="Open Runlog File(s)", MultiSelect:=True)

lngFileCount = FileCount(varFileList)

If lngFileCount = 0 Then Exit Function 'User canceled out of dialog box.

'Create A New WorkBook With One Worksheet In It
Workbooks.Add

For ilngFileNumber = 1 To lngFileCount

Runlog_File = CurrentFileName(varFileList, ilngFileNumber)
Open Runlog_File For Input As #ilngFileNumber

'Set The Counter to 1
Counter = 1

If ilngFileNumber = 1 Then
ActiveSheet.Name = "Runlog 1"
FirstSheet = "Runlog 1"
Else
Sheets.Add
ActiveSheet.Name = "Runlog " & Sheets.Count - 2
FirstSheet = "Runlog " & Sheets.Count - 2
Range("AB1").Value = "BASF"
End If

'Loop Until the End Of File Is Reached
Do While Seek(ilngFileNumber) <= LOF(ilngFileNumber)
'Display Importing Row Number On Status Bar
Application.StatusBar = "Importing Row " & _
Counter & " of text file " & Runlog_File
'Store One Line Of Text From File To Variable
Line Input #ilngFileNumber, ResultStr
'Store Variable Data Into Active Cell
If Left(ResultStr, 1) = "=" Then
ActiveCell.Value = "'" & ResultStr
Else
ActiveCell.Value = ResultStr
End If


'For Excel versions before Excel 97, change 65536 to 16384
If ActiveCell.Row = 64008 Then

Columns("A:A").TextToColumns Destination:=Range("A1"),
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False,
Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False,
FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1),
Array(5, 1), Array(6, 1), _
Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1),
Array(11, 1), Array(12, 1), Array(13, 1 _
), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1),
Array(18, 1), Array(19, 1), Array _
(20, 1), Array(21, 1), Array(22, 1), Array(23, 1)),
TrailingMinusNumbers:=True

If Not ActiveSheet.Name = FirstSheet Then
Range("A1:W64008").Cut Destination:=Range("A8:W64015")
CurrentSheet = ActiveSheet.Name
Sheets(FirstSheet).Select
Range("A1:W7").Copy
Sheets(CurrentSheet).Select
Range("A1").PasteSpecial Paste:=xlPasteAll
Else
End If

'Add A New Sheet
Sheets.Add
ActiveSheet.Name = "Runlog " & Sheets.Count - 2
Range("A1").Select

Else
'If Not The Last Row Then Go One Cell Down
ActiveCell.Offset(1, 0).Select
End If
'Increment the Counter By 1
Counter = Counter + 1
'Start Again At Top Of 'Do While' Statement
Loop
'Close The Open Text File
Close
'Remove Message From Status Bar
Application.StatusBar = False


'Format last Runlog sheets's data


Columns("A:A").TextToColumns Destination:=Range("A1"),
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False,
Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False,
FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5,
1), Array(6, 1), _
Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1),
Array(12, 1), Array(13, 1 _
), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18,
1), Array(19, 1), Array _
(20, 1), Array(21, 1), Array(22, 1), Array(23, 1)),
TrailingMinusNumbers:=True

Range("A1:W64008").Cut Destination:=Range("A8:W64015")
CurrentSheet = ActiveSheet.Name
Sheets(FirstSheet).Select
Range("A1:W7").Copy
Sheets(CurrentSheet).Select
Range("A1").PasteSpecial Paste:=xlPasteAll

Next

Sheets("Runlog 1").Select



'Fix Timing values to increment between files

For k = 1 To Sheets.Count - 2

Sheets("Runlog " & k).Select

If Range("AB1").Value = "BASF" Then

Sheets("Runlog " & k - 1).Select
Range("A8").Select
Selection.End(xlDown).Select
EndTime = ActiveCell.Value

For j = k To Sheets.Count - 2
Sheets("Runlog " & j).Select

LastRow = Cells(Rows.Count, "A").End(xlUp).Row
Columns("B:B").Insert Shift:=xlToRight
Range("B8").FormulaR1C1 = "=RC[-1]+" & EndTime
Range("B8").AutoFill Destination:=Range("B8:B" & LastRow)
Range("B8:B" & LastRow).Copy
Range("A8:A" & LastRow).PasteSpecial Paste:=xlPasteValues
Columns("B:B").Delete Shift:=xlToLeft

If j + 1 < Sheets.Count - 2 Then
If Sheets("Runlog " & j + 1).Range("AB1").Value = "BASF"
Then Exit For
End If

Next

End If

Next

End Function


Private Function FileCount(varFileList) As Long
Select Case VarType(varFileList)
Case vbBoolean
'User canceled out of the File Open dialog box.
FileCount = 0
Case vbString
'Dialog box is in single file mode.
'Single file selected for opening only.
FileCount = 1
Case vbArray + vbVariant
'Multiple files selected for processing.
FileCount = UBound(varFileList) - LBound(varFileList) + 1
End Select
End Function

Private Function CurrentFileName(varFileList As Variant, _
ilngFileNumber As Long) As String

Select Case VarType(varFileList)
Case vbBoolean
'User canceled out of the File Open dialog box.
CurrentFileName = ""
Case vbString
'Dialog box is in single file mode.
'Single file selected for opening only.
CurrentFileName = varFileList
Case vbArray + vbVariant
'Multiple files selected for processing.
'Return the filename currently pointed to.
CurrentFileName = CStr(varFileList(ilngFileNumber))
End Select
End Function
Click to expand...
Click to expand...
Click to expand...
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Problems with moving to next empty column 2
Forcing xl2K7 Column Count back to xl2K3 size 3
Permutations andText to column problem 6
Copy Array to Array, how to and should I? 13
Open a GroupWise .NAB File 6
Convert list to UPPER, lower & Proper cases. 21
VBA for Dependents shortcut menu 0
Copy part of text file 4

Top