Import 2 Different Text File Formats with Error Check

JRNelson

New Member
Joined
Feb 14, 2018
Messages
5
Hello Excel Gurus,

I have three different text file formats from three different programs that I'm trying to import into a spreadsheet to optimize coordinates data. I already have safety nets put into place in the event that the user cancels the file import, or if any errors occur during the import. The code is currently working very well for the data import of File Format 1 listed below. These are all tab or space delimited ASCII .txt files.

I'm now trying to figure out how to analyze the first line of the user-selected text file to determine which of the three types of file it is and then properly import the data. If the file format doesn't match any of the three file formats, then display a msgbox indicating that the selected file is not the correct format (in case the user selects an incorrect text file full of some other sort of data or text) and exit the sub. I'm imagining a nested IF or Else IF section, but I'm wondering if it would be more efficient (and cleaner) to call other subroutines?

This currently works when selecting multiple files (data from each file is imported and appended at the end of the previous file), and I'd like it to have that ability for the other two file formats as well, ideally being able to handle any of the three formats if a user selects multiple files and formats. I'm asking for any suggestions or ideas. Sorry if my code is a bit bulky and lengthy. I like to put in a lot of comments to remind myself what each section of the code is doing in case I have to go back and modify it months down the road.

Thank you in advance for any ideas, suggestions, or assistance!


File Format 1:

centroidpos[0] = X-30.1103 Y-56.7926 Z0
centroidpos[1] = X-29.9603 Y-56.7926 Z0
centroidpos[2] = X-29.8103 Y-56.7926 Z0
centroidpos[3] = X-29.6603 Y-56.7926 Z0
centroidpos[4] = X-29.5103 Y-56.7926 Z0
centroidpos[5] = X-11.6187 Y-56.7926 Z0

File Format 2:

-30.1103 -56.7926 0.0000
-29.9603 -56.7926 0.0000
-29.8103 -56.7926 0.0000
-29.6603 -56.7926 0.0000
-29.5103 -56.7926 0.0000
-11.6187 -56.7926 0.0000

File Format 3: (This format would need the 3rd column (Z coordinates) populated with 0's during or after import to match File Format 2. The spreadsheet will need X, Y, and Z data for other processing.)

-30.1103 -56.7926
-29.9603 -56.7926
-29.8103 -56.7926
-29.6603 -56.7926
-29.5103 -56.7926
-11.6187 -56.7926

Code:
Sub Import_PL()
    ' Add an error handler
    On Error GoTo ErrorHandler
    
    ' Speed up this sub-routine by turning off screen updating and auto calculating until the end of the sub-routine
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
  
    ' Define variable names and types
    Dim SaveCurrentDir As String
    Dim DefaultOpenPath As String
    Dim OpenFileName As Variant
    Dim i As Long
    Dim n As Long
    Dim fn As Integer
    Dim RawData As String
    Dim rngTarget As Range
    Dim rngFileList As Range
    Dim TargetRow As Long
    Dim FileListRow As Long
    Dim bLastRow As Long
    Dim hLastRow As Long
    Dim lLastRow As Long
    Dim x As Integer
    Dim y As Integer
    Dim z As Integer
    
    ' Set the default path to start at when importing a file
    On Error Resume Next
    If Len(Dir("F:\Data Files", vbDirectory)) = 0 Then
        
        DefaultOpenPath = "C:\"
        
        Else
        
        DefaultOpenPath = "F:\Data Files"
    End If
        
    ' When opening another file for processing, this section will save the previously opened file directory
    On Error Resume Next
    If SaveWorkingDir = CurDir Then
    
    ChDrive SaveWorkingDir
    ChDir SaveWorkingDir
    
    Else
    
    ChDrive DefaultOpenPath
    ChDir DefaultOpenPath
    
    End If
    
    ' Select the source folder and point list file(s) to import into worksheet
    OpenFileName = Application.GetOpenFilename( _
                   FileFilter:="Point List Files (*.txt), *.txt", _
                   Title:="Select a Point List file or files to import", _
                   MultiSelect:=True)
    
    ' Cancel the file import if the user exits the file import window or selects the Cancel button
    If Not IsArray(OpenFileName) Then
    
        MsgBox "" & vbNewLine & _
               "  Import Point List was aborted." & vbNewLine & _
               "" & vbNewLine & _
               "      No files were selected!", vbInformation, "File Import Cancelled"
        Exit Sub
    End If
             
    ' Save the user selected open file directory as the default open file path while the worksheet is open
    SaveWorkingDir = CurDir
    
    ' Timer Start (calculate the length of time this sub-routine takes to complete after selecting file(s) to import)
    StartTime = Timer
    ' Clear contents of cells and activate "Order Quantity" cell
    bLastRow = Cells(Rows.Count, "B").End(xlDown).Row
    hLastRow = Cells(Rows.Count, "H").End(xlDown).Row
    lLastRow = Cells(Rows.Count, "L").End(xlDown).Row
    Range("A1:G1").ClearContents
    If hLastRow > 0 Then
    Range("A101:AZ" & hLastRow).ClearContents
    Range("A101:AZ" & hLastRow).ClearFormats
    End If
    If bLastRow > 0 Then
        Range("B30:B" & bLastRow).ClearContents
        Range("B30:B" & bLastRow).ClearFormats
    End If
    Range("F5:F7").ClearContents
    Range("F11:F19").ClearContents
    Range("F28").ClearContents
    If lLastRow > 0 Then
        Range("H6:L" & lLastRow).ClearContents
        Range("H6:L" & lLastRow).ClearFormats
    End If
    Range("M1:X1").ClearContents
    ' Format all cell colors to file defaults
    Range("A1:AZ100").Interior.Color = RGB(175, 175, 175)
    Range("B4:F4").Interior.Color = RGB(200, 200, 200)
    Range("B10:F10").Interior.Color = RGB(200, 200, 200)
    Range("H4:K5").Interior.Color = RGB(200, 200, 200)
    Range("F5:F7").Interior.Color = RGB(200, 200, 200)
    Range("F23:F27").Interior.Color = RGB(255, 242, 204)
    
    ' Reset and activate "Order Quantity" cell
    Range("F23").Value = ("1")
    Range("F23").Activate
    
    ' Parse and import data from selected file(s)
    '*************************************************************************************
    '*                                                                                   *
    '* Need to add the ability to import X,Y and X,Y,Z tab delimited files with raw data *
    '*                                                                                   *
    '*************************************************************************************
    TargetRow = 0
    Set rngTarget = ActiveSheet.Range("H6")
    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 formula to prevent coordinate distance calculation 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
  
    ' Color spreadsheet background down to the last row of imported data and format imported coordinates as numbers with 4 decimal places, then
    ' Create a number list (autofill) in Col G to maintain original import sort order
    hLastRow = Cells(Rows.Count, "H").End(xlUp).Row
    Range("A1:AZ" & hLastRow).Interior.Color = RGB(175, 175, 175)
    Range("L5:L" & hLastRow).Font.Color = RGB(200, 200, 200)
    Range("L6") = "1"
    Range("L7") = "2"
    Range("L6:L7").AutoFill Destination:=Range("L6:L" & hLastRow), Type:=xlFillDefault
    Range("H6:K" & hLastRow).NumberFormat = "0.0000"
    
    ' List open file name(s) on spreadsheet for user reference
    Range("B33") = "Imported File(s):"
        Range("B33").Font.Name = "Calibri"
        Range("B33").Font.Size = 11
        Range("B33").Font.Bold = True
        Range("B33").Font.Color = RGB(0, 0, 255)
    FileListRow = 0
    Set rngFileList = ActiveSheet.Range("B34")
    For i = LBound(OpenFileName) To UBound(OpenFileName)
        Debug.Print OpenFileName(i)
        
        ' Add imported file name or hyperlink to imported files in list of imported files
        ' rngFileList.Offset(FileListRow, 0) = OpenFileName(i)
        rngFileList.Offset(FileListRow, 0).Hyperlinks.Add Anchor:=rngFileList.Offset(FileListRow, 0), _
        Address:=OpenFileName(i), _
        ScreenTip:="Imported File Number " & FileListRow + 1, _
        TextToDisplay:=OpenFileName(i)
        rngFileList.Offset(FileListRow, 0).Font.Name = "Calibri"
        rngFileList.Offset(FileListRow, 0).Font.Size = 8
        rngFileList.Offset(FileListRow, 0).Font.Color = RGB(0, 0, 255)
        
        FileListRow = FileListRow + 1
   
    Next i
    
    ' Format X, Y, Z, and Dist (mm) column headings to light pink to indicate to the user that the coordinates are not optimized
    Range("B4:F4").Interior.Color = RGB(255, 200, 200)
    Range("H4:K5").Interior.Color = RGB(255, 200, 200)
    
    ' Calculate the Original Point List Information based on the current imported XYZ sort order
    ' The Original Point List Information cells return the calculated values only, not the formula itself, in order to maintain the original imported file information
    Range("F5").Value = Evaluate("COUNT(H:H)")
    Range("F6").Value = Evaluate("SUM(K:K)")
    Range("F7").Value = Evaluate("((F6/F24)/86400)")
    Range("F11") = "=COUNT($H:$H)"
    Range("F12") = "=SUM($K:$K)"
    Range("F13") = "=(($F$12/$F$24)/86400)"
    Range("F14") = "=$F$6-$F$12"
    Range("F15") = "=((($F$12-$F$6)*-1)/$F$6)"
    Range("F16") = "=($F$7-$F$13)"
    Range("F17") = "=(((HOUR($F$13)*3600)+(MINUTE($F$13)*60)+(SECOND($F$13)))-((HOUR($F$7)*3600)+(MINUTE($F$7)*60)+(SECOND($F$7))))/((HOUR($F$7)*3600)+(MINUTE($F$7)*60)+(SECOND($F$7)))*-1"
    Range("F18") = "=(($F$11*$F$27)/86400)"
    Range("F19") = "=$F$13+$F$18"
    Range("F28") = "=$F$23*$F$19"
    
    ' Format X, Y, Z, Dist column headings to light pink to indicate to the user that coordinates are NOT optimized
    Range("B4:F4").Interior.Color = RGB(255, 200, 200)
    Range("H4:K5").Interior.Color = RGB(255, 200, 200)
    Range("B10:F10").Interior.Color = RGB(255, 200, 200)
    Range("F11:F19").Interior.Color = RGB(200, 200, 200)
    Range("B19:F19").Interior.Color = RGB(200, 200, 220)
    Range("B28:F28").Interior.Color = RGB(200, 200, 220)
    Range("F23").Interior.Color = RGB(200, 200, 220)
    Range("B22:F22").Interior.Color = RGB(200, 200, 200)
    
    ' Update Chart Title with definition of current sort order of XYZ coordinates
    Range("M1:X1").Interior.Color = RGB(255, 200, 200)
    Range("M1:X1") = "Raw Imported Point List Data Travel Path"
    
    ' Timer Stop (calculate the length of time this sub-routine took to complete)
    SecondsElapsed = Round(Timer - StartTime, 2)
    
    ' Turn screen updating and auto calculating back on since file processing is now complete
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    
    ' Display a message to report the sub-routine processing time after file selection including the number of data rows that have been imported
    MsgBox "Point List(s) processed and imported in " & SecondsElapsed & " seconds" & " ." & vbNewLine & _
           "      Successfully imported " & (TargetRow) & " coordinate points.", vbInformation, "Data Import Results"
' Reset to defaults in the event of a processing error during the sub-routine execution
ErrorHandler:
    Application.StatusBar = False
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    If Err.Number <> 0 Then
    
    ' Display a message to the user including the error code in the event of an error during execution
    MsgBox "An error number " & Err.Number & " was encountered!" & vbNewLine & _
           "Part or all of this VBA script was not completed.", vbInformation, "Error Message"
    End If
    
End Sub
 

Excel Facts

Will the fill handle fill 1, 2, 3?
Yes! Type 1 in a cell. Hold down Ctrl while you drag the fill handle.

Forum statistics

Threads
1,141,070
Messages
5,704,112
Members
421,327
Latest member
Msh

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top