Solved: Import a text file into excel delimited

[austenr]

I have a text file for input that looks like the line below. I need to be able to put for example the first 9 characters in the first cell of a row, the next 5 characters in the next cell, etc. It is a long line of text. Can someone please lend me an idea of how this could be accomplished with a macro? Thanks.

123456789jonescarl4beachctamytownma019308005551212

The result should be in separate cells on the same row:
123456789 | jones | carl | 4 beach ct | anytown | ma | 01930 | 8005551212

The | separates the fields and are meant to represent cells.

[mvidas]

Hi Austen,

This is just a quick example, but heres an idea you might be able to expand upon:[vba]Sub AustenFWExample()
Dim str1 As String, str2 As String, tempArr() As String
str1 = "123456789jonescarl4beachctamytownma019308005551212"
str2 = "987654321smithjohn123AnyStvillagestzipcdnpanxxyyyy"

Workbooks.Add 1
tempArr = SplitFixedWidth(str1, 9, 5, 4, 8, 7, 2, 5, 10)
Range("A1").Resize(1, UBound(tempArr) + 1) = tempArr
tempArr = SplitFixedWidth(str2, 9, 5, 4, 8, 7, 2, 5, 10)
Range("A2").Resize(1, UBound(tempArr) + 1) = tempArr

End Sub
Function SplitFixedWidth(ByVal FullStr As String, ParamArray Widths() As Variant) As String()
Dim i As Long, StrArr() As String, StartPos As Long
ReDim StrArr(UBound(Widths))
StartPos = 1
For i = 0 To UBound(Widths)
StrArr(i) = Mid$(FullStr, StartPos, CLng(Widths(i)))
StartPos = StartPos + CLng(Widths(i))
Next
SplitFixedWidth = StrArr
End Function[/vba]If you had to split an entire file at the same widths I wouldn't necessarily use a function like this for it, but it would still work the same. Let me know if you have any questions!
Matt

[austenr]

Thanks Matt. I will try it out.

[austenr]

Hey Matt, found this that will work a lot easier for me.

[VBA]
Const xlFixedWidth = 2

Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
objExcel.Workbooks.OpenText _
"C:\Scripts\Test.txt",,,xlFixedWidth,,,,,,,,,Array(Array(0,1),Array(14,1),A rray(32,1)) [/VBA]

BTW, I tried your code and it works fine, but this file is huge, 10 to 20 thousand lines and growing. Thanks for the hard work!

[austenr]

One thing I cannot find however is a similar script to be able to browse for the text file I want. Does anyone have any samples?

[lucas]

[VBA]Sub OpenMultipleFiles()
Dim fn As Variant, f As Integer
fn = Application.GetOpenFilename("Text-files,*.txt", _
1, "Select One Or More Files To Open", , True)
If TypeName(fn) = "Boolean" Then Exit Sub
For f = 1 To UBound(fn)
Debug.Print "Selected file #" & f & ": " & fn(f)
Workbooks.Open fn(f)
MsgBox ActiveWorkbook.Name, , "Active Workbook Name:"
ActiveWorkbook.Close False
' close the active workbook without saving any changes
Next f
End Sub[/VBA]

[austenr]

Ok I got it. The last part is I am having trouble filling column headings from the attached array code:

[VBA] Sub Sheet_Fill_Column_Headings()
Dim myarray As Variant
myarray = Array("January", "February", "March", "April", "May")
Range("a1:e1").Value = Application.WorksheetFunction.Transpose(myarray)
End Sub [/VBA]

What am I doing wrong? Thanks

[mdmackillop]

How about
[VBA]
For i = 1 To 5
Cells(1, i) = MonthName(i)
Next

[/VBA]

[lucas]

or wouldn't this work if he wants to use the array Malcolm:
[VBA]Range("a1:e1").Value = myarray[/VBA]

the transpose part has me confused. Are you trying to make the letters vertical?

[mdmackillop]

or
[VBA]
With Range("A1")
.Formula = "January"
.AutoFill Destination:=Range("A1:E1"), Type:=xlFillDefault
End With

[/VBA]

[austenr]

What I really have is column headings (not months just an example) from column A to Column CD. Wanted to load them with an array. I tried using the code I posted but it keeps repeating the first element in each column. How do you get it to move to the next element for the next column? Sorry if I confused you.

[mdmackillop]

Hi Austen
Steve's code should do that.

[lucas]

Didn't do the whole array for you but just add to this and change the range to suit:

[VBA]
Sub Sheet_Fill_Column_Headings()
Dim myarray As Variant
myarray = Array("Heading 1", "Heading 2", "Heading 3", "Heading 4", "Heading 5")
Range("a1:e1").Value = myarray
End Sub
[/VBA]

[mdmackillop]

If you have your headings in a column somewhere, then you can use your transpose function as follows
[VBA]Sub Sheet_Fill_Column_Headings()
Dim myarray As Variant
myarray = Range(Cells(1, 1), Cells(20, 1)).Value
Range(Cells(1, 3), Cells(1, 23)).Value = _
Application.WorksheetFunction.Transpose(myarray)
End Sub[/VBA]

[austenr]

Hi Steve and Malcomb,

Steve that last line is what got me. Once I changed it, it worked fine. Thanks. Malcomb, I hard coded my headings in the array but your code will be useful if I have to do this again. Plus, it is easier to modify your way. Thanks to you both. This one is solved.

[austenr]

One other question. The script I am using to load the text file into the worksheet (see above in post). I want to be able to start it on row 3 of the sheet the script creates and incorporate the headings array (also above). I have tried it several ways and cannot get it to work. Anyone have any ideas?

[mdmackillop]

Hi Austen,
Let's open this as a new question to save others having to work there way throught this.
Regards
MD

[lucas]

This works for me if you use Matt's code:

[VBA]
Option Explicit
Sub AustenFWExample()
Dim str1 As String, str2 As String, tempArr() As String
str1 = "123456789jonescarl4beachctamytownma019308005551212"
str2 = "987654321smithjohn123AnyStvillagestzipcdnpanxxyyyy"

Workbooks.Add 1
tempArr = SplitFixedWidth(str1, 9, 5, 4, 8, 7, 2, 5, 10)
Range("A3").Resize(1, UBound(tempArr) + 1) = tempArr
tempArr = SplitFixedWidth(str2, 9, 5, 4, 8, 7, 2, 5, 10)
Range("A4").Resize(1, UBound(tempArr) + 1) = tempArr

Dim myarray As Variant
myarray = Array("Heading 1", "Heading 2", "Heading 3", "Heading 4", "Heading 5")
Range("a1:e1").Value = myarray
End Sub
Function SplitFixedWidth(ByVal FullStr As String, ParamArray Widths() As Variant) As String()
Dim i As Long, StrArr() As String, StartPos As Long
ReDim StrArr(UBound(Widths))
StartPos = 1
For i = 0 To UBound(Widths)
StrArr(i) = Mid$(FullStr, StartPos, CLng(Widths(i)))
StartPos = StartPos + CLng(Widths(i))
Next
SplitFixedWidth = StrArr
End Function
[/VBA]

[austenr]

OK Malcomb. I am starting a new psot for this.