Import specific data from text files using vba

[JRNelson]

Hi everyone,

I will begin by apologizing for the lengthy post, but I wanted to make sure I included enough details to get the correct help. I am a long time Excel user, but fairly new to VBA. I have been trying to teach myself how to write a bit of VBA code to import data from text files, manipulate the data, and then export the data to a new text file after it has been optimized. I've been working on the VBA for the first command button on my worksheet (Import Point List) and have been trying to piece together bits of code I've found online. Now I'm approaching a deadline to get this done and I'm a bit stuck. Any assistance would be very much appreciated.

Here's a sample of the data in the text file. It will always be in this format, but the length of the file can vary from several hundred lines to several hundred thousand lines. There are no headers and the data starts on the first row of the file. Coordinates are not fa fixed length and may range from -250.0000 to 250.0000 for values.

sample1.txt
centroidpos[0] = X-5.2826 Y3.3400 Z0.5000
centroidpos[1] = X-5.4326 Y3.3400 Z0.5000
centroidpos[2] = X5.5826 Y-3.3400 Z0.5000
centroidpos[3] = X5.7326 Y-3.3400 Z0.5000
centroidpos[4] = X5.8826 Y3.3400 Z1.0000
centroidpos[5] = X6.0326 Y3.3400 Z1.0000
centroidpos[6] = X-6.1826 Y-3.3400 Z1.0000
centroidpos[7] = X-6.3326 Y-3.3400 Z1.0000
centroidpos[8] = X6.4826 Y3.3400 Z-0.5000
centroidpos[9] = X6.6326 Y3.3400 Z-0.5000
centroidpos[10] = X-6.7826 Y-3.3400 Z-0.5000
centroidpos[11] = X-6.9326 Y-3.3400 Z-0.5000

Desired Worksheet Result
https://1drv.ms/u/s!Ak5_WPnQMSfLiPg0CwFdHWzKJKHsGg


Here's what I'm trying to do:

1) Open a window with file filter so the user can select path and filename(s) to import. I'd like to use something like the following, including the MultiSelect:=True so that the user can import data from 1, 2, 3 or more text files at once and just append the data from each consecutive file to the bottom of each column.

Dim OpenFileName As Variant
' Select Point List file(s) and location to open in Excel
OpenFileName = Application.GetOpenFilename(FileFilter:="Point List Files (*.txt), *.txt", Title:="Select a file or files to import", MultiSelect:=True)
' Cancel data import and return to worksheet if user exits window without selecting a file
If OpenFileName = False Then
Exit Sub
End If

2) Clear any existing data from the Point List Data columns

' Clear any existing point list data and distance calculations
Range("H5:K1048576").ClearContents

3) Import only X, Y, and Z coordinate data from the text file(s), skipping the centroidpos[nn] and dropping the X, Y, and Z from the coordinate data. Data must be pasted to columns H, I, and J starting at row 5 (H5, J5, I5) as numbers with fixed 4 decimal places (nnn.nnnn)

4) Insert a formula starting at K6, then fill down this formula in column K adjacent to all cells populated from the data import.
K5 = blank cell
K6 = SQRT((H6-H5)^2+(I6-I5)^2)
K7 = SQRT((H7-H6)^2+(I7-I6)^2)
K8 = SQRT((H8-H7)^2+(I8-I7)^2)
...

5) Format cells H4:K4 with a light pink fill to show that the data in these columns has not been optimized yet.


Sample code I've pieced together so far, but definitely not complete! I'm not sure how to parse the data and paste it into the worksheet, add the formulas in column K, and format the fill colors for H4:K4. Any help would be awesome.

Private Sub Import_PL_Click()

' Timer Start (calculate the length of time this VBA code takes to complete)
Dim StartTime As Double
Dim SecondsElapsed As Double
StartTime = Timer

' Define variable names and types
Dim SaveCurrentDir As String
Dim DefaultOpenPath As String
Dim OpenFileName As Variant
Dim N As Long
Dim OpenFileNameInLoop As String
Dim DefaultSavePath As String

' Save the current directory
SaveCurrentDir = CurDir

' Set the path to the folder that you want to open by default
' Use DefaultOpenPath = Application.DefaultFilePath or define
' a custom path such as DefaultOpenPath = "C:\Temp"
DefaultOpenPath = "D:\GCT-Development"

' Change drive/directory to DefaultOpenPath
ChDrive DefaultOpenPath
ChDir DefaultOpenPath

' Select point list file and location to open in Excel
OpenFileName = Application.GetOpenFilename(FileFilter:="Point List Files (*.txt), *.txt", Title:="Select a file or files to import", MultiSelect:=True)

' Perform actions with the files selected
If IsArray(OpenFileName) Then
With Application
.ScreenUpdating = False
.EnableEvents = False
End With

For N = LBound(OpenFileName) To UBound(OpenFileName)

' Get only the file name and test to see if it is open.
OpenFileNameInLoop = Right(OpenFileName(N), Len(OpenFileName(N)) - InStrRev(OpenFileName(N), Application.PathSeparator, , 1))
If bIsBookOpen(OpenFileNameInLoop) = False Then
Set mybook = Nothing
On Error Resume Next
Set mybook = Workbooks.Open(OpenFileName(N))
On Error GoTo 0
If Not mybook Is Nothing Then

' Clear any existing point list data and distance calculations
Range("H5:K1048576").ClearContents

End If
Else
MsgBox "We skipped this file : " & OpenFileName(N) & " because it is already open."
End If

Next N
With Application
.ScreenUpdating = True
.EnableEvents = True

End With

End If

' Change drive/directory back to SaveCurrentDir.
ChDrive SaveCurrentDir
ChDir SaveCurrentDir
' Timer Stop (calculate the length of time this VBA code took to complete)
SecondsElapsed = Round(Timer - StartTime, 2)
MsgBox "This code ran successfully in " & SecondsElapsed & " seconds", vbInformation
End Sub
____________________________________________________________________________
Function bIsBookOpen(ByRef szBookName As String) As Boolean
' Contributed by Rob Bovey
On Error Resume Next
bIsBookOpen = Not (Application.Workbooks(szBookName) Is Nothing)
End Function

 

[PatOBrien198]

Here's some code that you might be able to use
It reads from the file, BUT NOT opened in Excel, parses the x, y and z values
It DOES NOT clear previous entries, or some of the other stuff your macro is doing...

Sub ImportIt()
Dim OpenFileName As Variant
On Error GoTo ErrorHandler
 ' Select Point List file(s) and location to open in Excel
 OpenFileName = Application.GetOpenFilename(FileFilter:="Point List Files (*.txt), *.txt", Title:="Select a file or files to import", MultiSelect:=True)
Dim n As Long
Dim fn As Integer
Dim RawData As String
Dim rngTarget As Range
Dim TargetRow As Long
Dim x As Integer
Dim y As Integer
Dim z As Integer
TargetRow = 0
Set rngTarget = ActiveSheet.Range("H5")
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
For n = LBound(OpenFileName) To UBound(OpenFileName)
    fn = FreeFile
    Open OpenFileName(n) For Input As [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=fn]#fn[/URL] 
    Application.StatusBar = "Processing ... " & OpenFileName(n)
    Do While Not EOF(fn)
        Line Input [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=fn]#fn[/URL] , RawData
        x = InStr(RawData, "X") + 1
        y = InStr(RawData, "Y") + 1
        z = InStr(RawData, "Z") + 1
        
        rngTarget.Offset(TargetRow, 0) = Mid(RawData, x, y - x - 2)
        rngTarget.Offset(TargetRow, 1) = Mid(RawData, y, z - y - 2)
        rngTarget.Offset(TargetRow, 2) = Mid(RawData, z, 99)
        rngTarget.Offset(TargetRow, 3).FormulaR1C1 = "= SQRT((RC[-3]-R[-1]C[-3])^2+(RC[-2]-R[-1]C[-2])^2)"
        TargetRow = TargetRow + 1
    Loop
    Close [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=fn]#fn[/URL] 
Next
ErrorHandler:
Application.StatusBar = False
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Sub

 

[JRNelson]

Thanks for such a quick reply and for the code! I inserted the piece of code that you posted and it seems to work with one minor issue. The data import stops after 4,240 rows have been imported. There are over 70,000 rows in the file I am importing to try out this code. I've had some files with over 200,000 rows. Is this a limitation for the method being used to import the data? Thank you again for your assistance.

 

[PatOBrien198]

My guess would be that there's some anomoly in the data that is causing it to error out and end.

Comment out the On Error statement and look at the data that is being read in and parsed.

You may need to put in some error checking, such as testing that x, y and z are greater than 10, or

Let me know what the row of data looks like that it is ending on.

Try this...

ErrorHandler:
If Err.Number <> 0 Then
    MsgBox RawData & vbCrLf & vbCrLf & Err.Description, vbCritical
End If
Application.StatusBar = False
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

 

[JRNelson]

My guess would be that there's some anomoly in the data that is causing it to error out and end.

Comment out the On Error statement and look at the data that is being read in and parsed.

You may need to put in some error checking, such as testing that x, y and z are greater than 10, or

Let me know what the row of data looks like that it is ending on.

Try this...

ErrorHandler:
If Err.Number <> 0 Then
    MsgBox RawData & vbCrLf & vbCrLf & Err.Description, vbCritical
End If
Application.StatusBar = False
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

Completely my fault on this one. Lesson learned... do NOT use a shared file on a network drive when testing code. Someone else "cleaned up" the file and reduced it to 4,240 rows of data for a new test sample. SHM...
Your code is working beautifully so far. Thank you again! I have a few more things from above that I'd like to get implemented, but the code timer, import, and cleanup of #VALUE ! formula error in K5 are now complete. You have been a HUGE help on this project.

Here's what I have so far:

[Private Sub Import_PL_Click()
    ' Add an error handler
    On Error GoTo ErrorHandler
    
    ' Define variable names and types
    Dim OpenFileName As Variant
    Dim SaveCurrentDir As String
    Dim DefaultOpenPath As String
    Dim n As Long
    Dim fn As Integer
    Dim RawData As String
    Dim rngTarget As Range
    Dim TargetRow As Long
    Dim x As Integer
    Dim y As Integer
    Dim z As Integer
    Dim DefaultSavePath As String
    
    ' Save the current directory
    SaveCurrentDir = CurDir
    
    ' Set the path to the folder that you want to open by default
    ' Use DefaultOpenPath = Application.DefaultFilePath or define
    ' a custom path such as DefaultOpenPath = "C:\Temp"
    DefaultOpenPath = "D:\GCT-Development"
    
    ' Change drive/directory to DefaultOpenPath
    ChDrive DefaultOpenPath
    ChDir DefaultOpenPath
    
    ' Select source folder and point list file(s) to import into worksheet
    OpenFileName = Application.GetOpenFilename( _
                   FileFilter:="Point List Files (*.txt), *.txt", _
                   Title:="Select a file or files to import", _
                   MultiSelect:=True)
            ' Cancel file import if user exits window
            'If OpenFileName = False Then
            'Exit Sub
            'End If
    
    ' Clear any existing point list data and distance calculations
    Range("H5:K1048576").ClearContents
    
    ' Timer Start (calculate the length of time this VBA code takes to complete)
    Dim StartTime As Double
    Dim SecondsElapsed As Double
    StartTime = Timer
    TargetRow = 0
    Set rngTarget = ActiveSheet.Range("H5")
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    For n = LBound(OpenFileName) To UBound(OpenFileName)
        fn = FreeFile
        Open OpenFileName(n) For Input As [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=fn]#fn[/URL] 
        Application.StatusBar = "Processing ... " & OpenFileName(n)
        Do While Not EOF(fn)
            Line Input [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=fn]#fn[/URL] , RawData
            x = InStr(RawData, "X") + 1
            y = InStr(RawData, "Y") + 1
            z = InStr(RawData, "Z") + 1
            
            rngTarget.Offset(TargetRow, 0) = Mid(RawData, x, y - x - 2)
            rngTarget.Offset(TargetRow, 1) = Mid(RawData, y, z - y - 2)
            rngTarget.Offset(TargetRow, 2) = Mid(RawData, z, 99)
            rngTarget.Offset(TargetRow, 3).FormulaR1C1 = "= SQRT((RC[-3]-R[-1]C[-3])^2+(RC[-2]-R[-1]C[-2])^2)"
            TargetRow = TargetRow + 1
        Loop
    
    ' Clear distance formula error from K5, then park selection box at A1
    Range("K5").ClearContents
    Range("A1").Select
        
        Close [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=fn]#fn[/URL] 
    Next
    
ErrorHandler:
    Application.StatusBar = False
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
          
    ' Change drive/directory back to SaveCurrentDir.
    ChDrive SaveCurrentDir
    ChDir SaveCurrentDir
    ' Timer Stop (calculate the length of time this VBA code took to complete)
    SecondsElapsed = Round(Timer - StartTime, 2)
    MsgBox "This code ran successfully in " & SecondsElapsed & " seconds", vbInformation
End Sub

/CODE]

 

[PatOBrien198]

perhaps a more elegant way to not have the formula pasted to K5 would be:

            rngTarget.Offset(TargetRow, 0) = Mid(RawData, x, y - x - 2)
            rngTarget.Offset(TargetRow, 1) = Mid(RawData, y, z - y - 2)
            rngTarget.Offset(TargetRow, 2) = Mid(RawData, z, 99)
            If TargetRow > 0 then
                  rngTarget.Offset(TargetRow, 3).FormulaR1C1 = "= SQRT((RC[-3]-R[-1]C[-3])^2+(RC[-2]-R[-1]C[-2])^2)"
             end if
             TargetRow = TargetRow + 1
        Loop

 

[JRNelson]

I've inserted the recommended suggestions and the import function is working very well! I can even select multiple files and it imports data from all files, so that's awesome! I have a two things I'm trying to tackle at this point with the file import and could use a little more help or suggestions from the team here. As always, MANY thanks for any assistance!

1. Section ' Cancel file import if user exits file import window or selects the Cancel button

When enabled, this section will stop the code and open the message box if I close the "Select files" window or hit the cancel button, but if I select one or more files and then click okay, nothing is processed. If I comment out this section, everything works fine. I'm thinking that I need to place the End If statement elsewhere in the script?

2. Section ' Parse and import data from selected files(s)

I have two input file formats. One is raw data from the CAD application output (TextSample1.txt and TextSample2.txt). The second instance would have to be able to import a "cleaned up" .txt file that only has X, Y, and Z numerical data (TextSample3.txt) or sometimes only X and Y numerical data (TextSample4.txt) that are separated by spaces. Is there a way to have this section of code deal with either input file format, or in some cases, if two or more input files are selected, be able to import from any of the 3 formats?

Here are the .txt sample files mentioned above:

TextSample1.txt
https://1drv.ms/t/s!Ak5_WPnQMSfLiPg8bANVmQno5sveug

TextSample2.txt
https://1drv.ms/t/s!Ak5_WPnQMSfLiPg7aTniFkQsE2193Q

TextSample3.txt
https://1drv.ms/t/s!Ak5_WPnQMSfLiPg9pUxPvgtvPO4PTQ

TextSample4.txt
https://1drv.ms/t/s!Ak5_WPnQMSfLiPg-OQZO_2pbVFl_Bw

Point List Optimizer (20180215_1417).xlsm
Here's the Excel .xlsm file with the below VBA code and worksheet:
https://1drv.ms/x/s!Ak5_WPnQMSfLiPg_fvKHpwEB36xjHA


Here's the code I have put together so far (including your suggestions):

Private Sub Import_PL_Click()

    ' Add an error handler
    On Error GoTo ErrorHandler
    
    ' Define variable names and types
    Dim SaveCurrentDir As String
    Dim DefaultOpenPath As String
    Dim OpenFileName As Variant
    Dim n As Long
    Dim fn As Integer
    Dim RawData As String
    Dim rngTarget As Range
    Dim TargetRow As Long
    Dim x As Integer
    Dim y As Integer
    Dim z As Integer
    
    ' Save the current directory
    SaveCurrentDir = CurDir
    
    ' Set the path to the folder that you want to open by default
    ' Use DefaultOpenPath = Application.DefaultFilePath or define
    ' a custom path such as DefaultOpenPath = "C:\Temp"
    DefaultOpenPath = "D:\GCT-Development"
    
    ' Change drive/directory to DefaultOpenPath
    ChDrive DefaultOpenPath
    ChDir DefaultOpenPath
    
    ' Select source folder and point list file(s) to import into worksheet
    OpenFileName = Application.GetOpenFilename( _
                   FileFilter:="Point List Files (*.txt), *.txt", _
                   Title:="Select a file or files to import", _
                   MultiSelect:=True)
    
    ' Cancel file import if user exits window
    'If OpenFileName = False Then
    '    MsgBox "" & vbNewLine & _
    '           " *********** NOTICE ***********" & vbNewLine & _
    '           "" & vbNewLine & _
    '           "  Import Point List was aborted." & vbNewLine & _
    '           "" & vbNewLine & _
    '           "      No files were selected!"
    '    Exit Sub
    '    End If
                
    ' Clear any existing point list data, calculations, and formats
    Range("H3:K4").Interior.ColorIndex = 0
    Range("H5:K1048576").ClearContents
    Range("F11").Activate
    
    ' Timer Start (calculate the length of time this VBA code takes to complete)
    Dim StartTime As Double
    Dim SecondsElapsed As Double
    StartTime = Timer
    TargetRow = 0
    Set rngTarget = ActiveSheet.Range("H5")
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    For n = LBound(OpenFileName) To UBound(OpenFileName)
        fn = FreeFile
        Open OpenFileName(n) For Input As [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=fn]#fn[/URL] 
        Application.StatusBar = "Processing ... " & OpenFileName(n)
        Do While Not EOF(fn)
            Line Input [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=fn]#fn[/URL] , RawData
            x = InStr(RawData, "X") + 1
            y = InStr(RawData, "Y") + 1
            z = InStr(RawData, "Z") + 1
            
            rngTarget.Offset(TargetRow, 0) = Mid(RawData, x, y - x - 2)
            rngTarget.Offset(TargetRow, 1) = Mid(RawData, y, z - y - 2)
            rngTarget.Offset(TargetRow, 2) = Mid(RawData, z, 99)
            
            ' Do not fill K5 with fomula to prevent calulation error on spreadsheet
            If TargetRow > 0 Then
                  rngTarget.Offset(TargetRow, 3).FormulaR1C1 = "= SQRT((RC[-3]-R[-1]C[-3])^2+(RC[-2]-R[-1]C[-2])^2)"
             End If
             TargetRow = TargetRow + 1
        Loop
        
        Close [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=fn]#fn[/URL] 
    
    Next
  
    ' Format X, Y, Z, Dist column headings to pink for non-optimized status
    Range("H3:K4").Interior.Color = RGB(255, 200, 200)
    
    ' Change drive/directory back to SaveCurrentDir.
    ChDrive SaveCurrentDir
    ChDir SaveCurrentDir
    
    ' Timer Stop (calculate the length of time this VBA code took to complete)
    SecondsElapsed = Round(Timer - StartTime, 2)
    
    ' Message to report VBA code processing time after file selection and number of data rows imported
    MsgBox "Point List(s) processed and imported in " & SecondsElapsed & " seconds" & " ." & vbNewLine & _
           "" & vbNewLine & _
           "      Successfully imported " & (TargetRow) & " coordinate points.", vbInformation, "Data Import Results"
ErrorHandler:
    Application.StatusBar = False
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
                
End Sub

 

[PatOBrien198]

I didn't look at your sample files, but the code should work with just the "X", Y and Z (no leading centroid...)

I have NOT tested the following code, but it may work for the 3rd format - numbers separated by spaces...

    Do While Not EOF(fn)
        Line Input [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=fn"]#fn[/URL] , RawData
        RawData = Trim(RawData)
        
        x = InStr(RawData, "X") + 1
        y = InStr(RawData, "Y") + 1
        z = InStr(RawData, "Z") + 1
        If y = 1 Then   ' no Y found, so assume file format is numbers separated by spaces
            y = InStr(RawData, " ") + 1
            z = InStr(y + 1, RawData + " ", " ") + 1
        End If
        rngTarget.Offset(TargetRow, 0) = Mid(RawData, x, y - x - 2)
        rngTarget.Offset(TargetRow, 1) = Mid(RawData, y, z - y - 2)
        rngTarget.Offset(TargetRow, 2) = Mid(RawData, z, 99)
        rngTarget.Offset(TargetRow, 3).FormulaR1C1 = "= SQRT((RC[-3]-R[-1]C[-3])^2+(RC[-2]-R[-1]C[-2])^2)"
        TargetRow = TargetRow + 1
    Loop