I have multiple files that I want to import into the same spreadsheet. The files are extension .asc but import as text, tab delimited, two columns wide. I want to then perform a -log() function on the second column. Then I want to plot the first column and the -log result.
I need to import row 57 after "DATA" to the end, in two columns.
The raw data files look like this:
PE IR SPECTRUM ASCII PEDS 1.60
-1
DUMMY.ASC
12/05/30
19:08:49.00
12/05/30
19:08:50.00
OELCHECK
ReferenceSpectrum = PerkinElmer
450.000000
4
SPECTRUM 400,CPU32 MAIN 00.09.9932 04-NOVEMBER-2009 13:58:07
MIR TGS
MIR
OPTKBR
86121
0.200000
4.000000
STARK
PROBE:
SPEKTRUM
MAGNITUDE
SHUTTLE
DOUBLE
COMBINED
0
#HDR
-1
-1
#GR
CM-1
%T
0.00002384185791015625
0.0
4000.000000
-1.000000
3551
8
58.613713
0.000456
#DATA
4000.000000 52.179804
3999.000000 52.218992
3998.000000 52.259096
etc...
I pieced this together by recording a macro and some steps found on other message boards, but I'm getting an error on the import step (highlighted in bold). The error is "Run-time error '1004': Application-defined or object defined error". Please help.
Sub Randi2()
'
' Randi2 Macro
'
Dim msg As String
Dim targetDir As String
Dim fileDescrip As String
Dim fName As String
'
msg = "Enter full path of directory where files " & _
"are to be found." & _
Chr(13) & "Example: C:\EXCEL" 'Chr(13) tabs to the next line
targetDir = Trim(InputBox(msg))
If targetDir = "" Then Exit Sub
If Right(targetDir, 1) = "\" Then
targetDir = Left(targetDir, Len(targetDir) - 1)
End If
ChDrive Left(targetDir, 1)
'display input box to get the file pattern for files to be opened
'Store input in variable fileDescrip
msg = "Enter the pattern for files to be opened." & _
Chr(13) & "Example: Book*.xls"
fileDescrip = Trim(InputBox(msg))
If fileDescrip = "" Then Exit Sub
'get first file (not necessarily in alphabetical order)
fName = Dir(targetDir & "\" & fileDescrip)
If Right(targetDir, 1) = "\" Then
targetDir = Left(targetDir, Len(targetDir) - 1)
End If
'if file found, open it and loop back and open other files
'Use on error to catch error if file can't be opened
Do
Range("B1").Select
With ActiveSheet.QueryTables.Add(Connection:= _
fName, Destination:= _
Range("$B$1"))
.Name = "2233253_1"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 57
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileOtherDelimiter = "|"
.TextFileColumnDataTypes = Array(1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
Range("D1").Select
ActiveCell.FormulaR1C1 = "=-LOG(RC[-1])"
Range("D1").Select
Selection.AutoFill Destination:=Range("D1:D3551")
Range("D1:D3551").Select
Columns("C:C").Select
Columns("D:D").Select
Selection.Copy
Range("E1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("C:D").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Range("C1").Select
fName = Dir()
Loop Until fName = ""
End Sub
I need to import row 57 after "DATA" to the end, in two columns.
The raw data files look like this:
PE IR SPECTRUM ASCII PEDS 1.60
-1
DUMMY.ASC
12/05/30
19:08:49.00
12/05/30
19:08:50.00
OELCHECK
ReferenceSpectrum = PerkinElmer
450.000000
4
SPECTRUM 400,CPU32 MAIN 00.09.9932 04-NOVEMBER-2009 13:58:07
MIR TGS
MIR
OPTKBR
86121
0.200000
4.000000
STARK
PROBE:
SPEKTRUM
MAGNITUDE
SHUTTLE
DOUBLE
COMBINED
0
#HDR
-1
-1
#GR
CM-1
%T
0.00002384185791015625
0.0
4000.000000
-1.000000
3551
8
58.613713
0.000456
#DATA
4000.000000 52.179804
3999.000000 52.218992
3998.000000 52.259096
etc...
I pieced this together by recording a macro and some steps found on other message boards, but I'm getting an error on the import step (highlighted in bold). The error is "Run-time error '1004': Application-defined or object defined error". Please help.
Sub Randi2()
'
' Randi2 Macro
'
Dim msg As String
Dim targetDir As String
Dim fileDescrip As String
Dim fName As String
'
msg = "Enter full path of directory where files " & _
"are to be found." & _
Chr(13) & "Example: C:\EXCEL" 'Chr(13) tabs to the next line
targetDir = Trim(InputBox(msg))
If targetDir = "" Then Exit Sub
If Right(targetDir, 1) = "\" Then
targetDir = Left(targetDir, Len(targetDir) - 1)
End If
ChDrive Left(targetDir, 1)
'display input box to get the file pattern for files to be opened
'Store input in variable fileDescrip
msg = "Enter the pattern for files to be opened." & _
Chr(13) & "Example: Book*.xls"
fileDescrip = Trim(InputBox(msg))
If fileDescrip = "" Then Exit Sub
'get first file (not necessarily in alphabetical order)
fName = Dir(targetDir & "\" & fileDescrip)
If Right(targetDir, 1) = "\" Then
targetDir = Left(targetDir, Len(targetDir) - 1)
End If
'if file found, open it and loop back and open other files
'Use on error to catch error if file can't be opened
Do
Range("B1").Select
With ActiveSheet.QueryTables.Add(Connection:= _
fName, Destination:= _
Range("$B$1"))
.Name = "2233253_1"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 57
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileOtherDelimiter = "|"
.TextFileColumnDataTypes = Array(1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
Range("D1").Select
ActiveCell.FormulaR1C1 = "=-LOG(RC[-1])"
Range("D1").Select
Selection.AutoFill Destination:=Range("D1:D3551")
Range("D1:D3551").Select
Columns("C:C").Select
Columns("D:D").Select
Selection.Copy
Range("E1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("C:D").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Range("C1").Select
fName = Dir()
Loop Until fName = ""
End Sub