View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
Matt S Matt S is offline
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