See that last post
for explanation
Code: Select all
' Improved Text Import using Index(OurUnjaggedJaggedArray() , {1\2\3 …..} , {1,2,3 …..}) https://eileenslounge.com/viewtopic.php?p=274367#p274367
Sub TextFileToExcel_IndxUnJgJgWay() ' http://www.eileenslounge.com/viewtopic.php?f=30&t=35100 http://www.eileenslounge.com/viewtopic.php?p=268809#p268809
Rem 1 Workbooks, Worksheets info
Dim Wb As Workbook, Ws As Worksheet
Set Wb = Workbooks("macro.xlsb") ' CHANGE TO SUIT
' Set Ws = Wb.Worksheets.Item(2) ' second worksheet
Set Ws = Wb.Worksheets("IndxUnJgJgWay") ' CHANGE TO SUIT
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 = 2 ' If there is no data in the worksheet we want the second row to be the start row
Else
Let NxtRw = lr + 1 ' If there is data in the worksheet, we want 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 & "\" & "NSEVAR_UnjJg.txt" ' "NSEVAR.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 NSEVER.txt: https://app.box.com/s/245h7i5nh6an8vw08g8t08fvu30ylih2
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 Variant
Rem 3 A 1D array of 1D arrays is built up by _....
Dim Cnt As Long
Dim arrUnjgdJgdRws() As Variant: ReDim arrUnjgdJgdRws(1 To RwCnt)
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
Let arrUnjgdJgdRws(Cnt) = arrClms() ' Fill the next 1 D array element in the unjagged jagged array of rows
Next Cnt
'3b Index(OurUnjaggedJaggedArray() , {1\2\3 …..} , {1,2,3 …..})
Let arrOut() = Application.Index(arrUnjgdJgdRws(), Evaluate("=Row(1:" & RwCnt & ")"), Evaluate("=Column(A:J)"))
Rem 4 Finally the array is pasted to the worksheet at the next free row
' Let Ws.Range("A" & NxtRw & "").Resize(RwCnt, 10).Value2 = arrOut()
Let Ws.Range("A" & NxtRw & ":J" & RwCnt + (NxtRw - 1) & "").Value2 = arrOut()
' Ws.Columns("A:J").AutoFit
Rem 5 to remove http://www.eileenslounge.com/viewtopic.php?p=272606&sid=7e8ad1b708dd49a811498ccac6b1e092#p272606 ..... when i click on any cell that has output there is an option numbers stored as text, convert to numbers,help on this error,ignore error,edit in formula bar,error checking options(these are the options coming)
'This does not need to be done in the Index(OurUnjaggedJaggedArray() , {1\2\3 …..} , {1,2,3 …..}) way
' Let Ws.Range("A" & NxtRw & ":J" & RwCnt + (NxtRw - 1) & "").Value2 = Evaluate("=IF(A" & NxtRw & ":J" & RwCnt + (NxtRw - 1) & "="""","""",IF(ISNUMBER(1*A" & NxtRw & ":J" & RwCnt + (NxtRw - 1) & "),1*A" & NxtRw & ":J" & RwCnt + (NxtRw - 1) & ",A" & NxtRw & ":J" & RwCnt + (NxtRw - 1) & "))") ' Based on =IF(F2="";"";IF(ISNUMBER(1*F2);1*F2;F2))
' Let Ws.Range("A" & NxtRw & ":J" & RwCnt + (NxtRw - 1) & "").Value2 = Evaluate("=IF(A" & NxtRw & ":J" & RwCnt + (NxtRw - 1) & "="""","""",IF(ISERROR(1*A" & NxtRw & ":J" & RwCnt + (NxtRw - 1) & "),A" & NxtRw & ":J" & RwCnt & ",1*A" & NxtRw & ":J" & RwCnt + (NxtRw - 1) & "))")
' Let Ws.Range("B" & NxtRw & ":D" & RwCnt + (NxtRw - 1) & "").Value2 = Evaluate("=IF(B" & NxtRw & ":D" & RwCnt + (NxtRw - 1) & "="""","""",IF(ISERROR(1*B" & NxtRw & ":D" & RwCnt + (NxtRw - 1) & "),B" & NxtRw & ":D" & RwCnt & ",1*B" & NxtRw & ":D" & RwCnt + (NxtRw - 1) & "))")
End Sub