import multiple .txt files into one sheet as a numbers, no text

[splitme81]

Hello,
I have data (numbers) in .txt files. I would like to import them into one worksheet as a numerical data, not as a text. I want the data to be in such format (MAKRO 1):

Sub import()
Dim FilePath As String
FilePath = Application.GetOpenFilename("Text Files (*.txt),*.txt", , "Select Text File", , False)
If FilePath = "False" Then Exit Sub
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & FilePath, Destination:=Range("A1"))
.PreserveFormatting = True
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 852
.TextFileStartRow = 1
.TextFileParseType = xlFixedWidth
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileFixedColumnWidths = Array(8, 6, 7, 9, 6, 6, 9, 5, 7, 7)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
.Delete
End With
 
End Sub

and I also would like to do it automatic in this way (MACRO 2)

Sub calosc()
Dim myDir As String, fn As String, txt As String, a(), n As Long, i As Long, ff As Integer
myDir = "c:\Arex2008\upper air sounding\Bodo\" '<- change here
fn = Dir(myDir & "*.txt")
 
Do While fn <> ""
ff = FreeFile
 
Open myDir & "\" & fn For Input As #ff
Do While Not EOF(ff)
Line Input #ff, txt
n = n + 1: ReDim Preserve a(1 To n)
a(n) = Split(txt, vbTab)
Loop
Close #ff
fn = Dir()
Loop
With ThisWorkbook.Sheets(1).Range("a1")
For i = 1 To n
.Offset(i - 1).Resize(, UBound(a(i)) + 1).Value = a(i)
Next
End With
End Sub

How to combine MACRO 1 and 2 into ONE??
please help me if you would be so kind.

 

[splitme81]

any suggestions?

 

[sapka]

Use this code to convert from string array to numeric array. It is for macro 2.

ReDim aa(1 To n, 1 To 11)
For i = 1 To n
    For ii = 1 To 11
        aa(i, ii) = CDbl(a(i)(ii - 1))
    Next ii
Next i

 

[splitme81]

Probably I'm not so wise as you. I've tried to placesed your code, but I don't know where. In what place it shoud be placed?

 

[splitme81]

Once again..
Where should I put your code? or should I splite it some how?

Sub calosc()
Dim myDir As String, fn As String, txt As String, a(), n As Long, i As Long, ff As Integer
myDir = "c:\xxx\xxx\Bodo\" '<- path
fn = Dir(myDir & "*.txt")
Do While fn <> "" 
        ff = FreeFile 
        Open myDir & "\" & fn For Input As #ff 
        Do While Not EOF(ff) 
            Line Input #ff, txt 
            n = n + 1 : Redim Preserve a(1 To n) 
            a(n) =  [URL="http://www.mrexcel.com/forum/\"http://www.ozgrid.com/Excel/freeze-panes.htm\">Freeze"]Split[/URL](txt, vbTab) 
        [URL="http://www.mrexcel.com/forum/\"http://www.ozgrid.com/VBA/VBACode.htm\">Deleting"]Loop[/URL] 
        Close #ff 
        fn = Dir() 
    Loop 
    With  [URL="http://www.ozgrid.com/forum/showthread.php?t=79250#"]ThisWorkbook[/URL].Sheets(1). [URL="http://www.mrexcel.com/forum/\"http://www.ozgrid.com/Excel/named-ranges.htm\">Named"]Range[/URL]("a1") 
        For i = 1 To n 
            .Offset(i-1).Resize(,UBound(a(i))+1).Value = a(i) 
        Next 
    End With 
End Sub

 

[sapka]

Sub calosc()
Dim myDir As String, fn As String, txt As String, a(), n As Long, i As Long, ff As Integer
myDir = "c:\Arex2008\upper air sounding\Bodo\" '<- change here
fn = Dir(myDir & "*.txt")
 
Do While fn <> ""
ff = FreeFile
 
Open myDir & "\" & fn For Input As #ff
Do While Not EOF(ff)
Line Input #ff, txt
n = n + 1: ReDim Preserve a(1 To n)
a(n) = Split(txt, vbTab)
Loop
Close #ff
fn = Dir()
Loop
ReDim aa(1 To n, 1 To 11)
For i = 1 To n
    For ii = 1 To 11
        aa(i, ii) = CDbl(a(i)(ii - 1))
    Next ii
Next i
ThisWorkbook.Sheets(1).Range("a1").Resize(n, 11) = aa
End Sub

Try.

 

[splitme81]

I've tryed as you said and error accoured at Line 55

aa(i, ii) = CDbl(a(i)(ii - 1))

- "type mismatch".
.. any soution?
(thank you for your patience once again..)

 

[sapka]

Please provide me a test file.

Just to see if it works, do the following:

On error resume next
For i = 1 To n
For ii = 1 To 11
aa(i, ii) = CDbl(a(i)(ii - 1))
Next ii
Next i
On error goto 0

It is not a final solution, I am just interested if my idea works at all.

I guess that you have less than 11 columns in your text files or maybe you have some non-numeric data.

 

[splitme81]

Hi,
In all .txt files there are always 11 columns, separated by spaces, only numerical data (no text), but, what can be a hint, thera are also a negative values e.g.

778.0 2160 1.4 -0.8 85 4.66 129 7 295.0 308.9 295.8
700.0 3002 -4.5 -8.4 74 2.91 115 6 297.5 306.5 298.0
665.0 3404 -7.7 -11.4 75 2.42 118 6 298.3 305.9 298.7
633.0 3786 -11.1 -11.5 97 2.52 121 6 298.6 306.5 299.1
622.0 3920 -11.1 -12.3 91 2.40 122 7 300.1 307.7 300.6
615.0 4007 -10.5 -16.5 61 1.72 123 7 301.8 307.4 302.1
612.0 4045 -10.7 -13.9 77 2.14 123 7 302.0 308.9 302.4

And once again I don`t know where put your code

On error resume next
For i = 1 To n
For ii = 1 To 11
aa(i, ii) = CDbl(a(i)(ii - 1))
Next ii
Next i
On error goto 0

 

[sapka]

How you was able to write your code in the first place?

Sub calosc()
Dim myDir As String, fn As String, txt As String, a(), n As Long, i As Long, ff As Integer
myDir = "c:\Arex2008\upper air sounding\Bodo\" '<- change here
fn = Dir(myDir & "*.txt")
 
Do While fn <> ""
ff = FreeFile
 
Open myDir & "\" & fn For Input As #ff
Do While Not EOF(ff)
Line Input #ff, txt
n = n + 1: ReDim Preserve a(1 To n)
a(n) = Split(txt, " ")
Loop
Close #ff
fn = Dir()
Loop
ReDim aa(1 To n, 1 To 11)
On Error Resume Next
For i = 1 To n
    For ii = 1 To 11
        aa(i, ii) = CDbl(a(i)(ii - 1))
    Next ii
Next i
On Error GoTo 0
ThisWorkbook.Sheets(1).Range("a1").Resize(n, 11) = aa
End Sub