Some notes in support of these Threads and posts
This thread , that thread
Hans penultimate
Code:
' 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
My modifed from last macro
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
Bookmarks