Appendix Thread. ( Codes for other Threads, ( Avinash ).)

**DocAElstein** · 08-06-2020, 01:53 PM

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