Solved: Import a single column text file

[JimS]

Below is some coded that I use to copy a single column of data from a text file.
Is there away to do this without having to use the “Text Import Wizard”.
I just need Column A of the Text File to be copied/pasted on to a sheet.
The paste should start at Cell A2.
Any ideas?
Thanks…
JimS

Sub Import_Text_File()

Dim DestBook As Workbook, SourceBook As Workbook
Dim DestCell As Range
Dim RetVal As Boolean

' Turn off screen updating.
Application.ScreenUpdating = False
With Worksheets("Data").Select
Range("A2:A65536").ClearContents
End With

' Set object variables for the active book and active cell.
Set DestBook = ActiveWorkbook
Set DestCell = ActiveCell

MsgBox "Please click OK and navigate to your Text File"
' Show the Open dialog box.
RetVal = Application.Dialogs(xlDialogOpen).Show("*.txt")
' If Retval is false (Open dialog canceled), exit the procedure.
If RetVal = False Then Exit Sub
' Set an object variable for the workbook containing the text file.
Set SourceBook = ActiveWorkbook
' Copy the contents of the entire sheet containing the text file.
Range(Range("A1"), Range("A1").SpecialCells(xlLastCell)).Copy
' Activate the destination workbook and paste special the values
' from the text file.
DestBook.Activate
Sheets("Data").Select
Range("A2").Select
DestCell.PasteSpecial Paste:=xlPasteFormats
DestCell.PasteSpecial Paste:=xlValues
'Cells.Select
Selection.Columns.AutoFit
Range("A1").Select
' Close the book containing the text file.
Application.DisplayAlerts = False
SourceBook.Close False
Application.DisplayAlerts = True

' Turn on screen updating.
Application.ScreenUpdating = True

' Run ("Macro1")

End Sub

[Kenneth Hobs]

If it is a text file, why do copy and paste? If you post a short example text file, we can better help.

[JimS]

I would have to remove too much private info and then the file wouldn't be of much help at that point. I just need to copy everything from a text file (notepad) and paste it to a single column on 1 sheet.

Using the Text Import Wizard I simply select Fixed Width and then Finish.

I was wondering if there is a way to automate this process so that I don't have to use the Text Import Wizard at all.

[Kenneth Hobs]

For me to show you a fast and easy method, I need an example of data. It is easy to make a simple text file in the same format. Simply delete everything except for say 3 columns and 4 or 5 rows and obfuscate sensitive data. That might take all of 3 minutes.

[JimS]

Ok, I've attached a small example of the Text File and a stripped down version of the workbook.

THANKS for your help...

JimS

[Kenneth Hobs]

That data is not in a standard CSV format. It is transposed. So, what would the column A data be?

Sequence Tran-4
Sequence Tran-1
etc.

or

Name: Sequence Tran-4
Run: 16
Lot: D0
Source: 60101
Color Code: 83
Output Cnt: 1
Destination : 60201
Status: Session is active.
Setting-A: 6
Setting-B: 6
Counts: 2383
P-Complete: 28
Time: N/A
Rerun: No Failure

Name: Sequence Tran-1
Run: 50
Lot: D0
Source: 60102
Color Code: 20
Output Cnt: 1
Destination : 60202
Status: Command is queued.
Setting-A: 6
Setting-B: 6
Counts: 0
P-Complete: 0
Time: N/A
Rerun: No Failure
etc.

[JimS]

Your second choice is correct.
The records would simply continue down Column-A like this:

Name: Sequence Tran-4
Run: 16
Lot: D0
Source: 60101
Color Code: 83
Output Cnt: 1
Destination : 60201
Status: Session is active.
Setting-A: 6
Setting-B: 6
Counts: 2383
P-Complete: 28
Time: N/A
Rerun: No Failure

Name: Sequence Tran-1
Run: 50
Lot: D0
Source: 60102
Color Code: 20
Output Cnt: 1
Destination : 60202
Status: Command is queued.
Setting-A: 6
Setting-B: 6
Counts: 0
P-Complete: 0
Time: N/A
Rerun: No Failure

Next set

Next set

Next set

etc

JimS

[Kenneth Hobs]

Option Explicit

Sub Import_Text_File()
Dim DestBook As Workbook, SourceBook As Workbook
Dim DestCell As Range
Dim fn As String, strFromFile As String, s() As String

' Turn off screen updating.
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Worksheets("Data").Range("A2:A" & Rows.Count).ClearContents

' Set object variables for the active book and active cell.
Set DestBook = ActiveWorkbook
Set DestCell = ActiveCell

'MsgBox "Please click OK and navigate to your Text File"

' Show the Open dialog box.
fn = FileOpen(ThisWorkbook.Path, "Text Files", "*.txt; *.csv")

' If Retval is false (Open dialog canceled), exit the procedure.
'If RetVal = False Then Exit Sub
If fn = "" Then Exit Sub

strFromFile = StrFromTXTFile(fn)
s() = Split(strFromFile, vbCrLf)
Worksheets("Data").Range("A2").Resize(UBound(s)).Value = WorksheetFunction.Transpose(s)
Worksheets("Data").Range("A:A").Columns.AutoFit

'Application.DisplayAlerts = True
' Turn on screen updating.
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

Function StrFromTXTFile(filePath As String) As String
Dim str As String, hFile As Integer

If Dir(filePath) = "" Then
StrFromTXTFile = "NA"
Exit Function
End If

hFile = FreeFile
Open filePath For Binary Access Read As #hFile
str = Input(LOF(hFile), hFile)
Close hFile

StrFromTXTFile = str
End Function

Function FileOpen(initialFilename As String, _
Optional sDesc As String = "Excel (*.xls)", _
Optional sFilter As String = "*.xls") As String
With Application.FileDialog(msoFileDialogOpen)
.ButtonName = "&Open"
.initialFilename = initialFilename
.Filters.Clear
.Filters.Add sDesc, sFilter, 1
.Title = "File Open"
.AllowMultiSelect = False
If .Show = -1 Then FileOpen = .SelectedItems(1)
End With
End Function

[JimS]

Excellent work - Thank you very much.

Works perfectly...