• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

.txt file data into .xls sheet

Dear Ninjas.
I have a list of customer data in a text file and I need help entering the info therein into an excel sheet as per the following columns: first name, last name, company, address, telephone, e-mail, job title, date updated.
4 such text files exist, holding altogether 3000 customers that each need to converted into separate rows containing relevant info in columns as described above.

Please see attached sample file for reference.
 

Attachments

  • Sampletxttoexcel.txt
    1.2 KB · Views: 15
Hi,
I doubt you can easily import that txt file. The data isn't arranged in columns or separated with a common delimiter ie comma or tab.
Can you get the data in any other format?
 
No dear its in the .txt format. please guide how can i import customer data as mentioned in the sample file.
your help is much appreciated.
Regards.
 
Hi Darling,
As I guessed, this will require a lot of work to deal with each line. Below is some example code to get you started. The txt file is imported from C:\ to sheet1 of a workbook and the required data is transferred to sheet2 of the same workbook.
Hope it helps.
PS: The 'import' code was created using the macro recorder for speed.

Code:
Sub TxtToExcel()

Dim wsFrom, wsTo As Worksheet
Dim i, j As Integer

Set wsFrom = Worksheets("Sheet1")
Set wsTo = Worksheets("Sheet2")

With wsFrom.QueryTables.Add(Connection:="TEXT;C:\Sampletxttoexcel.txt", _
  Destination:=Range("$A$1"))
  .Name = "Sampletxttoexcel_1"
  .FieldNames = True
  .RowNumbers = False
  .FillAdjacentFormulas = False
  .PreserveFormatting = True
  .RefreshOnFileOpen = False
  .RefreshStyle = xlInsertDeleteCells
  .SavePassword = False
  .SaveData = True
  .AdjustColumnWidth = True
  .RefreshPeriod = 0
  .TextFilePromptOnRefresh = False
  .TextFilePlatform = 850
  .TextFileStartRow = 1
  .TextFileParseType = xlDelimited
  .TextFileTextQualifier = xlTextQualifierNone
  .TextFileConsecutiveDelimiter = False
  .TextFileTabDelimiter = True
  .TextFileSemicolonDelimiter = False
  .TextFileCommaDelimiter = False
  .TextFileSpaceDelimiter = False
  .TextFileColumnDataTypes = Array(1)
  .TextFileTrailingMinusNumbers = True
  .Refresh BackgroundQuery:=False
End With

With wsFrom
  j = 2
  For i = 6 To 30 Step 23
  wsTo.Cells(j, 1) = Trim(Left(.Cells(i, 1), InStrRev(.Cells(i, 1), " ")))
  wsTo.Cells(j, 2) = Right(.Cells(i, 1), Len(.Cells(i, 1)) - InStrRev(.Cells(i, 1), " "))
  j = j + 1
  Next
End With

wsTo.UsedRange.EntireColumn.AutoFit

End Sub
 
Thanks dear Splash. It worked perfectly for the names. I am not that good in VBA. I will try if i can modify the code.
I'll get back if i could not do.
Many thanks :)
 
Dear Splash,
Could you please add one or two more steps so that i could figure out and proceed with the rest of the data.
Many thanks.
 
I've added lines for Company & Company Address and also adjusted first name to remove titles (Ms, Mrs, Mr etc).
Have fun with the rest

Code:
Sub TxtToExcel()

Dim wsFrom, wsTo As Worksheet
Dim i, j As Integer

Set wsFrom = Worksheets("Sheet1")
Set wsTo = Worksheets("Sheet2")
Dim sTmp As String

With wsFrom.QueryTables.Add(Connection:="TEXT;C:\Sampletxttoexcel.txt", _
  Destination:=Range("A1"))
  .Name = "Sampletxttoexcel_1"
  .FieldNames = True
  .RowNumbers = False
  .FillAdjacentFormulas = False
  .PreserveFormatting = True
  .RefreshOnFileOpen = False
  .RefreshStyle = xlInsertDeleteCells
  .SavePassword = False
  .SaveData = True
  .AdjustColumnWidth = True
  .RefreshPeriod = 0
  .TextFilePromptOnRefresh = False
  .TextFilePlatform = 850
  .TextFileStartRow = 1
  .TextFileParseType = xlDelimited
  .TextFileTextQualifier = xlTextQualifierNone
  .TextFileConsecutiveDelimiter = False
  .TextFileTabDelimiter = True
  .TextFileSemicolonDelimiter = False
  .TextFileCommaDelimiter = False
  .TextFileSpaceDelimiter = False
  .TextFileColumnDataTypes = Array(1)
  .TextFileTrailingMinusNumbers = True
  .Refresh BackgroundQuery:=False
End With

With wsFrom
  j = 2
  For i = 6 To 30 Step 23
  sTmp = Left(.Cells(i, 1), InStrRev(.Cells(i, 1), " ") - 2)
  sTmp = Right(sTmp, Len(sTmp) - InStrRev(sTmp, " "))
  wsTo.Cells(j, 1) = Trim(sTmp)
  wsTo.Cells(j, 2) = Right(.Cells(i, 1), Len(.Cells(i, 1)) - InStrRev(.Cells(i, 1), " "))
  wsTo.Cells(j, 3) = Replace(.Cells(i + 7, 1), "COMPANY:  ", "")
  wsTo.Cells(j, 4) = Replace(.Cells(i + 8, 1), "COMPANY ADDRESS:  ", "")
  j = j + 1
  sTmp = ""
  Next
End With

wsTo.UsedRange.EntireColumn.AutoFit

End Sub
 
Hi Ali,

Here's little different idea than what Splash has suggested.

If your 2 person's sample data matches exactly with the rest of the data then following code should work for you.

Note: I have not split the names as I noticed that they were not consistent (One has title and other hasn't). Maybe once you run complete list then some kind of pattern will emerge.

Could you please test the below code?
Code:
Public Sub ProcessTextFile()
Dim objFSO As FileSystemObject
Dim objTxt As TextStream
Dim varData As Variant
Dim i As Long, lCnt As Long, lRow As Long
Dim strFileName As String

'\\ Choose File
With Application.FileDialog(msoFileDialogFilePicker)
  .AllowMultiSelect = False
  .Title = "Select Text File to process!"
  .Filters.Add "Text Files", "*.txt"
  .Show
  strFileName = .SelectedItems(1)
End With

'\\ Read data in array
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTxt = objFSO.OpenTextFile(strFileName, ForReading)
varData = Split(objTxt.ReadAll, vbCrLf)
objTxt.Close

'\\ Process Array
For i = LBound(varData) To UBound(varData)
  If LCase(Trim(varData(i))) Like "*[0-9]* of [0-9]* documents*" Then
  lCnt = 1
  lRow = Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Row
  End If
  Select Case lCnt
  Case 6
  Cells(lRow, 1).Value = Trim(varData(i))
  Case 13
  Cells(lRow, 3).Value = Trim(Mid(varData(i), InStr(1, varData(i), ":", vbTextCompare) + 1, 199))
  Case 14
  Cells(lRow, 4).Value = Trim(Mid(varData(i), InStr(1, varData(i), ":", vbTextCompare) + 1, 199))
  Case 15
  Cells(lRow, 5).Value = Trim(Mid(varData(i), InStr(1, varData(i), ":", vbTextCompare) + 1, 199))
  Case 16
  Cells(lRow, 6).Value = Trim(Mid(varData(i), InStr(1, varData(i), ":", vbTextCompare) + 1, 199))
  Case 19
  Cells(lRow, 7).Value = Trim(Mid(varData(i), 1, 40))
  Cells(lRow, 8).Value = CDate(Trim(Mid(varData(i), 41, 10)))
  Case Else
  End Select
   
  lCnt = lCnt + 1
Next i

End Sub
It will prompt you select text file and after selecting text file it will process data. in the column sequence you have mentioned leaving 2nd column (last name) blank as mentioned above.
 
Hi Shrivallabha,
I tried, it gives compile error. User defined-type not defined.
Sorry I forgot to mention that part.

You can handle that in two ways. Change following lines:
Code:
Dim objFSO As FileSystemObject
Dim objTxt As TextStream
to
Code:
Dim objFSO As Object
Dim objTxt As Object

Or
Goto Visual Basic Editor | Tools | References and then select
Microsoft Scripting Runtime
and press OK. This is called Early binding and above option is Late binding.
Then you don't have to do above changes.
 
Dear Shrivallabha.
Thanks for the grand help. can i try this code with my 4 text file, each containing approx 1000 customer identically structured data?
 
Thanks @shrivallabha for your method. its working perfectly fine.
Dear @Splash
Below is the code. i am stuck, can you please guide me to complete the solution.
thanks

Code:
Sub TxtToExcel()

Dim wsFrom, wsTo As Worksheet
Dim i, j As Integer

Set wsFrom = Worksheets("Sheet1")
Set wsTo = Worksheets("Sheet2")
Dim sTmp As String

With wsFrom.QueryTables.Add(Connection:="TEXT;C:\Sampletxttoexcel2.txt", _
  Destination:=Range("A1"))
  .Name = "Sampletxttoexcel_1"
  .FieldNames = True
  .RowNumbers = False
  .FillAdjacentFormulas = False
  .PreserveFormatting = True
  .RefreshOnFileOpen = False
  .RefreshStyle = xlInsertDeleteCells
  .SavePassword = False
  .SaveData = True
  .AdjustColumnWidth = True
  .RefreshPeriod = 0
  .TextFilePromptOnRefresh = False
  .TextFilePlatform = 850
  .TextFileStartRow = 1
  .TextFileParseType = xlDelimited
  .TextFileTextQualifier = xlTextQualifierNone
  .TextFileConsecutiveDelimiter = False
  .TextFileTabDelimiter = True
  .TextFileSemicolonDelimiter = False
  .TextFileCommaDelimiter = False
  .TextFileSpaceDelimiter = False
  .TextFileColumnDataTypes = Array(1)
  .TextFileTrailingMinusNumbers = True
  .Refresh BackgroundQuery:=False
End With

With wsFrom
  j = 2
  For i = 6 To 60 Step 23
  sTmp = Left(.Cells(i, 1), InStrRev(.Cells(i, 1), " ") - 2)
  sTmp = Right(sTmp, Len(sTmp) - InStrRev(sTmp, " "))
  wsTo.Cells(j, 1) = Trim(sTmp)
  wsTo.Cells(j, 2) = Right(.Cells(i, 1), Len(.Cells(i, 1)) - InStrRev(.Cells(i, 1), " "))
  wsTo.Cells(j, 3) = Replace(.Cells(i + 7, 1), "COMPANY:  ", "")
  wsTo.Cells(j, 4) = Replace(.Cells(i + 8, 1), "COMPANY ADDRESS:  ", "")
    wsTo.Cells(j, 5) = Replace(.Cells(i + 9, 1), "TELEPHONE:  ", "")
  wsTo.Cells(j, 6) = Replace(.Cells(i + 10, 1), "E-MAIL:  ", "")
  wsTo.Cells(j, 7) = Replace(.Cells(i + 15, 1), "  ", "")
  wsTo.Cells(j, 8) = Replace(.Cells(i + 13, 1), "  ", "")
  j = j + 1
  sTmp = ""
  Next
End With

wsTo.UsedRange.EntireColumn.AutoFit

End Sub
 
As I have mentioned above in post #8, names do not have pattern. There are three entries in the attached file as below.

Melissa Chew (has no title)
Ms Michelle Crocco (has title)
Asfandyar Ali (has no title)

So with the complete list there could be several variations of above data with Ms, Miss, Mrs, Mr thrown in sometimes. Is there anything that is common or fixed?
 
Hi Ali,

Here is the gist of Processing Array.
  • We build array of all text file lines using combined Split + ReadAll method of TextStream object available in FileSystemObject.
  • To process array of unknown sizes we For Next loop with lbound(min index in the array) and ubound(max index in the array). That is the outermost loop in array processing.
  • In your data I noticed that each record started with line like "1 of 335 DOCUMENTS" and then each of the data required was at fixed number of interval from this point so I added a local counter variable lCnt which gets reset to one as soon as it locates line like above. Here's the portion which checks for such new record.
    Code:
      If LCase(Trim(varData(i))) Like "*[0-9]* of [0-9]* documents*" Then
      lCnt = 1
      lRow = Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Row
      End If
  • Afterwards we use select statement which is very similar to If statement with condition lCnt (local counter) so as to extract desired data and ignore the rest.

I am posting revised code. Please replace old code with this and test. I am not sure as to how you could change poles with the data inconsistency in the names. I have tried to handle it but with insufficient information there's not much to work on anyway. There are additional comments in the process array section which should help you.
Code:
Option Explicit
Public Sub ProcessTextFile()
Dim objFSO As FileSystemObject
Dim objTxt As TextStream
Dim varData As Variant
Dim i As Long, lCnt As Long, lRow As Long
Dim strFileName As String, strData As String

'\\ Choose File
With Application.FileDialog(msoFileDialogFilePicker)
  .AllowMultiSelect = False
  .Title = "Select Text File to process!"
  .Filters.Add "Text Files", "*.txt"
  .Show
  strFileName = .SelectedItems(1)
End With

'\\ Read data in array
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTxt = objFSO.OpenTextFile(strFileName, ForReading)
varData = Split(objTxt.ReadAll, vbCrLf)
objTxt.Close

'\\ Process Array
For i = LBound(varData) To UBound(varData)
  If LCase(Trim(varData(i))) Like "*[0-9]* of [0-9]* documents*" Then
  lCnt = 1
  lRow = Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Row
  End If
  Select Case lCnt
  Case 6  '\\Person Name
  '\\Check number of words in the line and take action accordingly
  If UBound(Split(Application.Trim(varData(i)), " ")) = 1 Then
  Cells(lRow, 1).Value = Split(Application.Trim(varData(i)), " ")(0)
  Cells(lRow, 2).Value = Split(Application.Trim(varData(i)), " ")(1)
  Else
  Cells(lRow, 1).Value = Split(Application.Trim(varData(i)), " ")(1)
  Cells(lRow, 2).Value = Split(Application.Trim(varData(i)), " ")(2)
  End If
  Case 13 '\\Company
  Cells(lRow, 3).Value = Trim(Mid(varData(i), InStr(1, varData(i), ":", vbTextCompare) + 1, 199))
  Case 14 '\\address
  Cells(lRow, 4).Value = Trim(Mid(varData(i), InStr(1, varData(i), ":", vbTextCompare) + 1, 199))
  Case 15 '\\telephone
  Cells(lRow, 5).Value = Trim(Mid(varData(i), InStr(1, varData(i), ":", vbTextCompare) + 1, 199))
  Case 16 '\\email
  Cells(lRow, 6).Value = Trim(Mid(varData(i), InStr(1, varData(i), ":", vbTextCompare) + 1, 199))
  Case 19 '\\Job title and date updated on same line
  Cells(lRow, 7).Value = Trim(Mid(varData(i), 1, 40))
  Cells(lRow, 8).Value = CDate(Trim(Mid(varData(i), 41, 10)))
  Case Else
  End Select
   
  lCnt = lCnt + 1
Next i

End Sub
 
Back
Top