Home Menu

Menu


ExcelBanter » Excel Newsgroups » Excel Programming > Forcing to load one file before another
Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 112
Default Forcing to load one file before another
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



Reply With QuoteReply With Quote
  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 9,101
Default Forcing to load one file before another
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" wrote:

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



Reply With QuoteReply With Quote
  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 112
Default Forcing to load one file before another
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" wrote:

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" wrote:

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



Reply With QuoteReply With Quote
  #4   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 9,101
Default Forcing to load one file before another
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" wrote:

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" wrote:

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" wrote:

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



Reply With QuoteReply With Quote
Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes
Linear Mode Linear Mode

Posting Rules
Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On

Similar Threads
Thread Thread Starter Forum Replies Last Post
External References - Forcing Relative File Referencing Brad Abbott Excel Worksheet Functions 0 March 21st 07 04:57 AM
Forcing Excel to Load Below Office Toolbar Bill Helbron Excel Discussion (Misc queries) 2 October 2nd 05 04:09 PM
Macros forcing file open brodine Excel Programming 2 July 29th 05 02:45 PM
Is it possible to load an .xls file Jako[_55_] Excel Programming 2 August 2nd 04 11:29 PM
How to load a help file using VBA Ian[_9_] Excel Programming 2 January 30th 04 02:19 PM


All times are GMT +1. The time now is 12:40 AM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"

 

Contact Us ExcelBanter forum home Privacy Statement