Macro in support of this Thread and posts.
This thread ,
that thread
http://www.eileenslounge.com/viewtop...272682#p272682
https://eileenslounge.com/viewtopic....272706#p272706
( and probably a dozen more in the next few months.... )
_.___________________________Code:Sub TextFileToExcel_GroundhogDay12b() ' 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("Mylastmacro") ' 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.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 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).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) 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) & "))") ' 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
Macro.xlsb : https://app.box.com/s/uwpnuqmnc1uxpl0wpfrbh52iqr1enfcv
NSEVER.txt : https://app.box.com/s/245h7i5nh6an8vw08g8t08fvu30ylih2




Reply With Quote
Bookmarks