Import Data from txt file in specific cells

[marissaliana]

Hi,

I need your help. I have a txt file with two columns. One names and next to each name, the birth date. I want to import these data into an excel file. The first column should keep the names and the second column the dates. I have searched through different codes and the only thing I am able to do is to save the whole text from the txt file into a string array and then send it back to the excel. My problem is that with this way, it's not possible to use these data for further editing in different Macros.

What I was thinking it to read the txt file and each time we detect space going to the next column and when we detect line change, change row in the excel. I don't know if it is possible, so has anybody any idea??

I attach the text file as zip (the system doesn't allowed me to attach it directly) and the wanted result excel file as it is

Thank you

19144

[mdmackillop]

To avoid error, can you post your txt file

[marissaliana]

To avoid error, can you post your txt file

I edit my previous post and added both files.

[mdmackillop]

Try this, but there may be an issue with decimal separation.

Option Explicit


Function ReadAllTextFile()
Dim TF, x, y, i, j, cel
Const ForReading = 1, ForWriting = 2
Dim fso, f

Set fso = CreateObject("Scripting.FileSystemObject")

Set f = fso.OpenTextFile("C:\Docs\New1.txt", ForReading) 'Set as required
TF = f.ReadAll
x = Split(TF, vbCr)
For i = 0 To UBound(x)
y = Split(x(i), vbTab)
j = j + 1
Cells(j, 1).Resize(, UBound(y) + 1) = y
Next i
For Each cel In Columns(2).SpecialCells(xlCellTypeConstants)
cel.Value = Trim(cel) * 1
Next

End Function

[marissaliana]

Try this, but there may be an issue with decimal separation.



It appears a problem with decimal but before this the code, stills copy each line of the text file in one cell. It doesn't split them to two columns. This is my greatest problem.

[marissaliana]

UPDATE:

I found this code that works excellent (https://stackoverflow.com/questions/20301663/importing-separate-rows-and-columns-from-a-txt-file-into-an-excel-worksheetvba)

Sub sof20301663ImportTextFile() Const ForReading = 1, ForWriting = 2, ForAppending = 3


Dim i, iup, varArray
Dim fso As Object, tso As Object
Dim strFilePath, strLine


' adapt here your text file name: '
strFilePath = "C:\new2.txt"


Set fso = CreateObject("Scripting.FileSystemObject") '
' get TextStream:


Set tso = fso.OpenTextFile(strFilePath, ForReading)


i = 2
Do While Not tso.AtEndOfStream '
' read a line from the file:
strLine = tso.ReadLine
' split with separator tab:
varArray = Split(strLine, vbTab)
iup = UBound(varArray)
' split with separator space:


If (iup <= 0) Then
varArray = Split(strLine, " ")
iup = UBound(varArray)
End If

If Not IsEmpty(varArray(0)) Then

' fill a cell: using strLine as range address:


strLine = "A" & i
Range(strLine).Value = varArray(0)
Range(strLine).NumberFormat = "General"

End If


' if there is more then two words, fill cell 2:


If (iup > 0) Then
If Not IsEmpty(varArray(UBound(varArray))) Then
strLine = "B" & i
Range(strLine).Value = varArray(UBound(varArray))
Range(strLine).NumberFormat = "General"
End If
End If
i = i + 1


Loop


' clean objects:


tso.Close
Set tso = Nothing


Set fso = Nothing




End Sub




Just one problem. When I have an empty line in the text file, the array doesn't fill with empty but with 'No Variable' and I have a bug error.
How can I handle the empty lines in the text file??

[mdmackillop]

Option Explicit

'Adapted from https://stackoverflow.com/questions/20301663/importing-separate-rows-and-columns-from-a-txt-file-into-an-excel-worksheetvba

Sub sof20301663ImportTextFile()
Const ForReading = 1, ForWriting = 2, ForAppending = 3
Dim i, iup, varArray
Dim fso As Object, tso As Object
Dim strFilePath, strLine

' adapt here your text file name: '
strFilePath = "C:\Users\mdmac\OneDrive\New1.txt"
Set fso = CreateObject("Scripting.FileSystemObject") '
' get TextStream:
Set tso = fso.OpenTextFile(strFilePath, ForReading)
i = 2
Do While Not tso.AtEndOfStream '
' read a line from the file:
strLine = tso.ReadLine
' split with separator tab:
varArray = Split(strLine, vbTab)
iup = UBound(varArray)
' split with separator space:
If (iup <= 0) Then
varArray = Split(strLine, " ")
iup = UBound(varArray)
End If

On Error Resume Next
If Not IsEmpty(varArray(0)) Then
If Not Err = 9 Then 'Blank line error
' fill a cell: using strLine as range address:
strLine = "A" & i
Range(strLine).Value = varArray(0)
Range(strLine).NumberFormat = "General"
End If
End If
On Error GoTo 0
' if there is more then two words, fill cell 2:
If (iup > 0) Then
If Not IsEmpty(varArray(UBound(varArray))) Then
strLine = "B" & i
Range(strLine).Value = varArray(UBound(varArray))
Range(strLine).NumberFormat = "General"
End If
End If
i = i + 1
Loop
' clean objects:
tso.Close
Set tso = Nothing
Set fso = Nothing
End Sub

[mana]

Option Explicit

Sub test()
Const myTxt As String = "C:\new2.txt"

With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & myTxt, Destination:=Range("A1"))
.TextFileConsecutiveDelimiter = True
.TextFileTabDelimiter = True
.TextFileSpaceDelimiter = True
.Refresh BackgroundQuery:=False
.Delete
End With

End Sub

[marissaliana]

Thank you!!