Some notes in support of these Threads and posts
This thread , that thread
Hans penultimate
My modifed from last macroCode:' https://eileenslounge.com/viewtopic.php?p=272599#p272599 https://eileenslounge.com/viewtopic.php?p=272605#p272605 Sub STEP2() ' Hans penultimate Dim w1 As Workbook Set w1 = ActiveWorkbook ' CHANGE TO SUIT Dim ws1 As Worksheet 'Set ws1 = w1.Worksheets.Item(2) Set ws1 = w1.Worksheets("HansPenultimate") ' CHANGE TO SUIT Dim MyData As String Dim lineData() As String, strData() As String, myFile As String Dim i As Long, rng As Range 'On Error Resume Next 'myFile = "C:\Users\WolfieeeStyle\Desktop\NSEVAR.txt" myFile = ThisWorkbook.Path & "\NSEVAR.txt" ' CHANGE TO SUIT Open myFile For Binary As #1 MyData = Space$(LOF(1)) Get #1, , MyData Close #1 lineData() = Split(MyData, vbNewLine) Set rng = ws1.Range("A2") For i = 0 To UBound(lineData) strData = Split(lineData(i), ",") rng.Offset(i, 0).Resize(1, UBound(strData) + 1) = strData Next ' ws1.Range("A:A").Select ' ' ' Selection.TextToColumns Destination:=ws1.Range("A1"), DataType:=xlDelimited, _ ' TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _ ' Semicolon:=False, Comma:=True, Space:=False, Other:=False, OtherChar _ ' :=",", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, _ ' 1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1)), _ ' TrailingMinusNumbers:=True ws1.Columns("A:Z").AutoFit ws1.Range("A1").Select w1.Save End Sub
Code:Sub TextFileToExcel_GroundhogDay12() ' 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 = 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 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 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(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) & "))") ' 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) & "))") End Sub
Hans final macro in this thread
Code:Sub STEP2_() ' 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) Dim w1 As Workbook Dim ws1 As Worksheet Dim MyData As String Dim lineData() As String, strData() As String, myFile As String Dim i As Long, rng As Range 'myFile = "C:\Users\WolfieeeStyle\Desktop\NSEVAR.txt" myFile = ThisWorkbook.Path & "\NSEVAR.txt" Open myFile For Binary As #1 MyData = Space$(LOF(1)) Get #1, , MyData Close #1 lineData() = Split(MyData, vbNewLine) Set w1 = ActiveWorkbook Set ws1 = w1.Worksheets.Item(2) With ws1.Range("A2").Resize(UBound(lineData) + 1) .Value = Application.Transpose(lineData) .TextToColumns Destination:=ws1.Range("A2"), DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, Comma:=True, _ FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), _ Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1)) End With End Sub




Reply With Quote
Bookmarks