Preserving "columns" when writing from a text file to excel using VBA
Assuming that each column is 10
characters long, I would use this width instead of a space delimeter
Sub FeedTextFileToActiveSheet(ByVal TextFile As String)
Dim i As Integer, Line As String
Open TextFile For Input As #1
While Not EOF(#1)
i = i + 1
Input #1, Line
Range("A" & i) = Trim(Mid(Line, 1, 10)) 'Business ID
Range("B" & i) = Trim(Mid(Line, 11, 10)) 'Employee ID
' ... and so on
Wend
Close #1
End Sub
To use it, just call FeedTextFileToActiveSheet("Path.txt")
Have you tried the "import from text file option" of excel? If you just want to import the text file to excel with or without headers, then you can import directly in excel using the built in option available in excel.This recognises the header and blank spaces properly.One point to be noted is the headers of the text file should always be in first line for this method. If you are not sure of this, then you can go for a vba script.if so, then the link provided by ferdinando will help you.
If you have this file organized visually, I would go by that logic. It means that value of a column starts where the column header starts. This implies that value of a column ends where the next one begins.
Helpful image, describing the logic (also, example text file I used):
All this logic can be done by reading first line, which contains headers, and determining all indexes of beginning of every header. Then, for each line we can easily determine value between two particular indexes, cut it out and trim to remove extra spaces at the beginning and at the end of a value.
Try below code (all necessary comments in code):
Sub ReadDataFromCsv()
Dim Fn As String, WS As Worksheet, st As String, i As Long, columnHeadersIndexes As Object, numberOfColumns As Long
Fn = "your path here" ' the file path and name
Set WS = Sheets("Sheet1")
' Create array that will hold indexes of a beginning of a column header
Set columnHeadersIndexes = CreateObject("System.Collections.ArrayList")
'Read text file to st string
With CreateObject("Scripting.FileSystemObject")
If Not .FileExists(Fn) Then
MsgBox Fn & " : is missing."
Exit Sub
ElseIf FileLen(Fn) = 0 Then
MsgBox Fn & " : is empty"
Else
With .OpenTextFile(Fn, 1)
' Read first line
st = .ReadLine
i = 1
' Find beginning of first column name
Do While Mid(st, i, 1) = " "
i = i + 1
Loop
columnHeadersIndexes.Add (i)
' At least two spaces separate two headers, so we can safely add 2 without risk of loosing any letters frmo next header
i = i + 2
Dim j As Long: j = 1
Do While i < Len(st)
' If we have two spaces followed by non-space, then save index (beginning of a header)
If Mid(st, i - 2, 2) = " " And Mid(st, i, 1) <> " " Then
' Set column header
Cells(1, j) = Mid(st, columnHeadersIndexes(columnHeadersIndexes.Count - 1), i - columnHeadersIndexes(columnHeadersIndexes.Count - 1) - 1)
columnHeadersIndexes.Add (i)
j = j + 1
End If
i = i + 1
Loop
' Set column header
Cells(1, j) = Trim(Mid(st, columnHeadersIndexes(columnHeadersIndexes.Count - 1), Len(st)))
numberOfColumns = columnHeadersIndexes.Count
' Skip line with ------ characters
.ReadLine
Dim currentRow As Long: currentRow = 2
Do While .AtEndOfStream <> True
st = .ReadLine
' Read all columns from a line
For i = 0 To numberOfColumns - 2
If Len(st) >= columnHeadersIndexes(i) Then
cellValue = Mid(st, columnHeadersIndexes(i), columnHeadersIndexes(i + 1) - columnHeadersIndexes(i) - 1)
cellValue = Trim(cellValue)
Cells(currentRow, i + 1) = cellValue
End If
Next
' Read last column, if exists
If Len(st) >= columnHeadersIndexes(i) Then
'here we pass Len(st) as length for substring - it assures that we don't pass too small value and miss some characters
cellValue = Mid(st, columnHeadersIndexes(i), Len(st))
cellValue = Trim(cellValue)
Cells(currentRow, i + 1) = cellValue
End If
currentRow = currentRow + 1
Loop
.Close
End With
End If
End With
End Sub