Copying last 18 records of text file to worksheet

[sdruley]

URL:
https://www.screencast.com/t/Zq5GPIg7Dsm
EMBEDDED CODE:
<!-- copy and paste. Modify height and width if desired. --> <a href="https://content.screencast.com/users/pharaohdruley/folders/Default/media/1f24e3a6-f70e-4c59-98e5-08f405443f6c/09.08.2018-11.38.png"><img class="embeddedObject" src="https://content.screencast.com/users/pharaohdruley/folders/Default/media/1f24e3a6-f70e-4c59-98e5-08f405443f6c/09.08.2018-11.38.png" width="2670" height="1028" border="0" /></a>

 

[Domenic]

Maybe something like this...

Option Explicit

Sub CopyLast18RecordsOfTextFileToWorksheet()


    Dim oFSO As Object
    Dim oFile As Object
    Dim oTextStream As Object
    Dim sFullName As String
    Dim vText As Variant
    Dim LastRow As Long
    
    sFullName = "C:\Users\Domenic\Desktop\sample.txt"
    
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    
    If Not oFSO.FileExists(sFullName) Then
        MsgBox "File not found!", vbExclamation
        Exit Sub
    End If
    
    Set oFile = oFSO.GetFile(sFullName)
    
    If oFile.Size = 0 Then
        MsgBox "File is empty!", vbExclamation
        Exit Sub
    End If
    
    Set oTextStream = oFile.OpenAsTextStream
    
    vText = Split(oTextStream.ReadAll, vbCrLf)
    
    Worksheets.Add
    
    Range("A1").Resize(UBound(vText) + 1).Value = Application.Transpose(vText)
    
    LastRow = Cells(Rows.Count, "A").End(xlUp).Row
    If LastRow - 18 > 0 Then
        Rows("1:" & LastRow - 18).Delete
        LastRow = Cells(Rows.Count, "A").End(xlUp).Row
    End If
    
    Range("A1:A" & LastRow).TextToColumns _
        Destination:=Range("A1"), _
        DataType:=xlDelimited, _
        Comma:=True


    oTextStream.Close
    
    Set oFSO = Nothing
    Set oFile = Nothing
    Set oTextStream = Nothing
    
End Sub

Hope this helps!