i have this code but if there are blank spaces at the end of the text file it wont work... is there a way to get this code to removethe blank lines at the end befor it calls it over? 

Function ReadData(ByVal PartNumber As String)

    Dim adoStream   As Object
    Dim Data()      As Variant
    Dim Filename    As String
    Dim Filepath    As String
    Dim Fields      As Variant
    Dim n           As Long
    Dim Records     As Variant
    Dim Text        As String
    
    Const adTypeText = 2

        'Change to  data path
        Filepath = "T:\Pub\Groups\Production\       ' Filepath = "C:\Users\Joshua\Desktop\Partinfo\"
           
        'Filename = Filepath & PartNumber
        'finds file name clostes to number in textbox1
        Debug.Print Dir(Filepath & PartNumber & "*.txt")
        Filename = Filepath & Dir(Filepath & PartNumber & "*.txt")
        
        If Dir(Filename) = "" Then
            MsgBox "File Not Found."
            Exit Function
        End If
        
      ' Create Stream object.
        Set adoStream = CreateObject("ADODB.Stream")
  
      ' Specify stream type - text data.
        adoStream.Type = adTypeText
  
      ' Specify charset Default is UTF-8.
        adoStream.Charset = "UTF-8"
  
      ' Open the stream.
        adoStream.Open
       
      ' Load the file data from disk To stream object
        adoStream.LoadFromFile Filename
  
      ' Open the stream And get binary data from the object
        Text = adoStream.ReadText
        
       ' Close the stream.
        adoStream.Close
       

        Records = Split(Text, vbCrLf & vbCrLf)
        n = UBound(Records)
       
        Lines = Split(Records(n), vbCrLf)
   
       ReDim Data(UBound(Lines) - 4, 1)
          

        For n = 3 To UBound(Lines) - 1
            Fields = Split(Lines(n), "|")
            Data(n - 3, 1) = Fields(1)
            Data(n - 3, 0) = Fields(UBound(Fields))
            
           
        Next n
       
        
        ReadData = Data
        
End Function