macro for this post http://www.eileenslounge.com/viewtop...268809#p268809
Code:' From vixer zyxw1234 Avinash : http://www.eileenslounge.com/viewtopic.php?f=30&t=34629 DF.txt https://app.box.com/s/gw941dh9v8sqhvzin3lo9rfc67fjsbic Excel File, https://app.box.com/s/yyzt8ywwpkkn8vxtxumalp7eg3888jnu Sample1.xlsx Sub TextFileToExcel() ' http://www.eileenslounge.com/viewtopic.php?p=268809#p268809 Rem 1 Workbooks, Worksheets info Dim Wb As Workbook, Ws As Worksheet Set Wb = Workbooks("Sample1.xlsx") ' CHANGE TO SUIT Set Ws = Wb.Worksheets.Item(1) ' first worksheet Dim lr As Long: Let lr = Ws.Range("A" & Ws.Rows.Count & "").End(xlUp).Row ' http://www.excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=11466&viewfull=1#post11466 Making Lr dynamic ( using rng.End(XlUp) for a single column. ) Dim NxtRw As Long If lr = 1 And Ws.Range("A1").Value = "" Then Let NxtRw = 1 ' If there is no data in the worksheet we want the first row to be the start row Else Let NxtRw = lr + 1 ' If there is data in the worksheet, we ant the data to be posted after the last used row End If Rem 2 Text file info ' 2a) get the text file as a long single string Dim FileNum As Long: Let FileNum = FreeFile(1) ' https://msdn.microsoft.com/en-us/vba/language-reference-vba/articles/freefile-function Dim PathAndFileName As String, TotalFile As String Let PathAndFileName = ThisWorkbook.Path & "\csv Text file Chaos\" & "DF.txt" ' CHANGE TO SUIT From vixer zyxw1234 : http://www.eileenslounge.com/viewtopic.php?f=30&t=34629 DF.txt https://app.box.com/s/gw941dh9v8sqhvzin3lo9rfc67fjsbic Open PathAndFileName For Binary As #FileNum 'Open Route to data. Binary is a fundemental type data input... TotalFile = Space(LOF(FileNum)) '....and wot recives it has to be a string of exactly the right length Get #FileNum, , TotalFile Close #FileNum ' 2b) Split into wholes line _ splitting the text file into rows by splitting by vbCr & vbLf ( Note vbCr & vbLf = vbNewLine ) Dim arrRws() As String: Let arrRws() = Split(TotalFile, vbCr & vbLf, -1, vbBinaryCompare) Dim RwCnt As Long: Let RwCnt = UBound(arrRws()) + 1 ' +1 is nedeed as the Split Function returns indicies 0 1 2 3 4 5 etc... ' we can now make an array for all the rows, and we know our columns are A-J = 10 columns Dim arrOut() As String: ReDim arrOut(1 To RwCnt, 1 To 10) Rem 3 An array is built up by _.... Dim Cnt As Long For Cnt = 1 To RwCnt ' _.. considering each row of data Dim arrClms() As String Let arrClms() = Split(arrRws(Cnt - 1), ",", -1, vbBinaryCompare) ' ___.. splitting each row into columns by splitting by the comma Dim Clm As Long ' For Clm = 1 To UBound(arrClms()) + 1 Let arrOut(Cnt, Clm) = arrClms(Clm - 1) Next Clm Next Cnt Rem 4 Finally the array is pasted to the worksheet at the next free row Let Ws.Range("A" & NxtRw & "").Resize(RwCnt, 10).Value = arrOut() End Sub
Share ‘sample1.xlsx’ : https://app.box.com/s/r0tc0hkwoxrqjsqfu4gh7eqyy5jmqlg2
Share ‘macro.xlsm’ : https://app.box.com/s/599q2it3uck3hfwm5kscmmgtn0be66wt




Reply With Quote
Bookmarks