Dear all,

I'm using Excel 2007 to import large text files using VBA code. In the text file I'll say a bit more about in a moment, the the first column of numbers are longitude, the second latitude and columns from there on, data point values.

The first problem is that when a very small number is encountered (e.g. 4.2321E-02) in the text file, upon import to Excel, the 'number' is imported into the correct cell, yet the E-02 is put into the adjacent cell, causing the number to be split up - this also causes subsequent values to be shifted one cell further along than they should be. I was wondering therefore if there's a way of keeping the E-02 attached to the end of the number. I've noticed that in the text file sometimes there is a space between the number and the E-x part (most often for the latitude and longitude values) with often no space for the data point values. Any suggestions are of course welcome on how to get round this!

The second problem is a bit of an odd one. Upon import of the data, the final cell of each row and positions in the dataset where there is meant to be no value (ie. a blank cell), a question mark in a box appears (this doesn't appear in the text file). I'm wondering whether this is meant to be some kind of carriage-return marker or something akin to this. Anyway, I thought it would be easy to remove, just using find and replace to make the cell blank once more - however, as this isn't a text character, it won't let me copy and paste it into the find/replace box. So I'm a little confused how to get rid of this.

Each text file is around 300MB (told you it was a large import!), so I've uploaded a smaller sample one to www.megaupload.com in case you need to have a look - it's still quite big mind you. To view it, please go to the following website: http://www.megaupload.com/?d=6NN199FN and enter in the anti-spam code in the top-right corner.

The code as it stands is as follows:

'"Text Files (*.txt),*.txt
Option Explicit
Sub LargeFileImport()
     Const MaxRows As Long = 1048576
     'Dimension Variables
     Dim ResultStr As String
     Dim FileName As String
     Dim FileNum As Integer
     Dim Counter As Double
     Dim num() As Variant
     Dim v As Variant, i As Long, j As Long
     Dim s As String, sChr As String
     Dim rw As Long
     'Ask User for File's Name
     FileName = Application.GetOpenFilename( _
       FileFilter:="Text Files (*.txt),*.txt")
     'Check for no entry
     If FileName = "" Then End
     'Get Next Available File Handle Number
     FileNum = FreeFile()
     'Open Text File For Input
     Open FileName For Input As #FileNum
     'Turn Screen Updating Off
     'Application.ScreenUpdating = False
     'Set The Counter to 1
     Counter = 1
     'Loop Until the End Of File Is Reached
     s = ""
     rw = 1
     Do While Seek(FileNum) <= LOF(FileNum)
        'Display Importing Row Number On Status Bar
        ' Application.StatusBar =
        Debug.Print "Importing Row " & _
            Counter & " of text file " & FileName
         'Store One Line Of Text From File To Variable
         ResultStr = Input(1000, #FileNum)
         'Store Variable Data Into Active Cell
         For i = 1 To Len(ResultStr)
           sChr = Mid(ResultStr, i, 1)
           If Asc(sChr) = 10 Then
             If Len(Trim(s)) > 0 Then
               v = Split(Application.Trim(s), " ")
               ReDim num(LBound(v) To UBound(v))
               For j = LBound(v) To UBound(v)
                 num(j) = v(j)
               Next
               ' Change 'rw' no. to alter import starting column
               Cells(rw, 1).Resize(1, _
                 UBound(v) - LBound(v) + 1) = num
               rw = rw + 1
               s = ""
               Erase v
               If rw > MaxRows Then
                 ActiveSheet.Next.Select
                 rw = 1
               End If
             End If
           Else
              s = s & sChr
           End If
         Next
         'Increment the Counter By 1
         Counter = Counter + 1
       '  If Counter > 1E+307 Then
       '    Exit Do
       '  End If
     'Start Again At Top Of 'Do While' Statement
     Loop
     'Close The Open Text File
     Close
     If Len(Trim(s)) > 0 Then
       v = Split(Application.Trim(s), " ")
       ReDim num(LBound(v) To UBound(v))
       For j = LBound(v) To UBound(v)
         num(j) = CSng(v(j))
       Next
       ' Change 'rw' no. to alter import starting column
       Cells(rw, 1).Resize(1, _
         UBound(v) - LBound(v) + 1) = num
       rw = rw + 1
       s = ""
       Erase v
       If rw > 1048576 Then
         ActiveSheet.Next.Select
         rw = 1
       End If
     End If
    
     'Remove Message From Status Bar
     Application.StatusBar = False
  End Sub
Many thanks for your time and effort, I appreciate it.

Best wishes,
Steve