Capping Consecutive delimiters during text file importing

Question

Hey I am very new to VBA and trying to make the macro someone else made more universally able to handle different data files I work with. There are 2 main data file layouts one that uses consecutive space delimiters (up to 8 spaces) and one that is single space delimited which is fine but if the single space delimited data is missing info in one of the columns it uses specifically 11 spaces. Using the TextFileConsecutiveDelimiter = True code line it removes that column completely and the macro panics as it can not find the data as it shifts to far right in some cases.

Private Sub Cmdpopulate_Click()
filei = 0
filepath = InputBox("Please enter file path to be imported") & ""                                                                                        'asks user for the file path (the files should be named with integers sequentially)
filemax = InputBox("How many files do you wish to import?")                                                                                                                 'asks user how many files to import, this sets a maximum number to cycle through
Do While filei \< filemax                                                                                                                                                    'begins the file import loop, starting at filei (initially 0) up to filemax (defined above)
filei = filei + 1
filename = filei & ".txt"                                                                                                                                               'filename is the current filei integer and the extention
foffset = filei + 19
imptxt                                                                                                                                                                  'import file sub routine (see below)
Loop
add_frames
format_tables
Sheet1.Cells(1, 1).Select
'    cmdpopulate.Visible = False
End Sub

Public Sub imptxt()
Sheet2.Range("a4").CurrentRegion.Offset(500, 0).Resize(, 40).Clear                                                                                                          'clears the table
With Sheet2.QueryTables.Add(Connection:= \_
"TEXT;" & filepath & filename, Destination:=Sheet2.Range("$A$4"))
.Name = Sheet2.Range("b1").Value
.TextFilePlatform = 874
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileOtherDelimiter = "?"
.TextFileSpaceDelimiter = True
.TextFileConsecutiveDelimiter = True
.Refresh BackgroundQuery:=True
.RefreshStyle = xlOverwriteCells
End With                                                                                                                                                                    'opens file  filename (defined above) at filepath (defined above), delimites for '?' overwrites any data in existing cells
Sheet2.Range("a1") = filepath                                                                                                                                               'inserts filepath in cell a1, troubleshooting only
Sheet2.Range("a2") = filename                                                                                                                                               'inserts filename in cell b2, troubleshooting only
'  Sheet2.Select
If filei = 1 Then
headers
End If
send                                                                                                                                                                        'goes to the send subroutine to put data from the import table into the summary table
End Sub

This is the code I managed to do so far which works for 90% of the data but for a certain data structure (the one with the gaps) it gives a runtime error 13 type mismatch error pop-up in the part of the code that is taking the values from the query table that the above code creates and pasting them in a different sheet to summarise the data. I do not know if it is possible to get it to treat consecutive delimiters as one but also understand that 11 spaces means to leave a cell blank. Any help much appreciated. Sorry if the formatting is wrong first time posting here. I was asked to show some of the data sets I am using, below are the 3 types of data I am trying to get one set of code to work for (linked pictures of the .txt file and copy and pasted versions as the formatting is wrong on the copy pasted ones)

Data set (single space delimited)

Feature      Unit   Nominal    Actual      Tolerances      Deviation

Step 20 - 17 
Width         mm +017.00000 +016.91924 +00.20000 -00.20000 -000.08076       
 
Step 21 - 18 - Width 
Width         mm +014.00000 +014.00860 +00.20000 -00.20000 +000.00860       
 
Step 22 - 18 - Width 
Width         mm +014.00000 +013.98360 +00.20000 -00.20000 -000.01640         
 
Step 23 - 18 - Width
Width         mm +014.00000 +014.03760 +00.20000 -00.20000 +000.03760   

Data set (consecutive delimiters (6-8 spaces))

Feature    Unit    Nominal   Actual          Tolerances       Deviation 

Step 11 - 6.1   4.0 (+/- 0.4)
Radius      mm    +4.000    +4.111        +0.400      -0.400     +0.111          
   
Step 15 - 8   12 (+/- 0.4)
Radius      mm    +12.000   +12.407       +0.400      -0.400     +0.407           
   
Step 16 - 6.2  4 (+/- 0.4)
Radius      mm    +4.000    +3.890        +0.400      -0.400     -0.110               
   
Step 17 - 2 - 16.5 CtQ (+/- 0.5)
Max Width   mm    +16.500   +16.608       +0.500      -0.500     +0.108             
   
Step 19 - 6.3 - 4.0 (+/- 0.4)
Radius      mm    +4.112     +4.046      +0.400      -0.400     -0.066 

Data set that breaks it (has gaps that are always 11 spaces)

Feature      Unit  Nominal   Actual      Tolerances      Deviation   

Step 19 - Hole 11 - Dia
Diameter      in +0000.1630 +0000.1633 +000.0020 -000.0020 +0000.0003        
 
Step 20 - Hole 12 - Dia
Diameter      in +0000.1630 +0000.1634 +000.0020 -000.0020 +0000.0004   
 
Step 22 - Hole 1 - TP
True Positio  in    *(11 space)*        +0000.0010 +000.0100  *(11 space)*         +0000.0010    

Step 23 - Hole 2 - TP
True Positio  in     *(11 space)*       +0000.0027 +000.0100    *(11 space)*       +0000.0027     
 
Step 24 - Hole 3 - TP
X Location    in -0002.0460 -0002.0455    *(11 space)   (11space)*                  -0000.0005           
Y Location    in +0000.0000 -0000.0016    *(11 space)   (11space)               -0000.0016*           
True Positio  in     *(11space)*   +0000.0033 +000.0100 (11space)    +0000.0033        

Answer 1

It seems the text files were exported from software or an application. If that’s the case, there’s likely no way to control how the system handles blank values during export.

Note: The script provides a basic solution but is not refined enough to import the data as a well-organized table on the worksheet. Issues such as spaces in the title row (e.g., Step 22 - Hole 1 - TP) and feature names (e.g., Y Location) may require additional script to process the imported data.

A possible solution would be to replace the 11 spaces with a placeholder before importing the file into Excel.

Public Sub imptxt()
    Dim filePath As String: filePath = "d:\temp\"  ' modify as needed
    Dim fileName As String: fileName = "test1.txt"
    Dim newName As String: newName = Replace(fileName, ".txt", "_fix.txt")
    Const PLACE_HOLDER = "##"
    Call ReplaceSpaces(filePath, fileName, newName)
    Sheet1.Cells.Clear
    With Sheet1.QueryTables.Add(Connection:= _
        "TEXT;" & filePath & newName, Destination:=Sheet1.Range("$A$4"))
        .Name = Sheet1.Range("b1").Value
        .TextFileColumnDataTypes = Array(2, 2, 2, 2, 2, 2, 2, 2)
        .TextFilePlatform = 874
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileOtherDelimiter = " "
        .TextFileSpaceDelimiter = True
        .TextFileConsecutiveDelimiter = True
        .Refresh BackgroundQuery:=True
        .RefreshStyle = xlOverwriteCells
    End With                                                                                                                
    Sheet1.Range("a1") = filePath
    Sheet1.Range("a2") = fileName
    Sheet1.UsedRange.Replace What:=PLACE_HOLDER, Replacement:="", LookAt:=xlWhole, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
End Sub
Sub ReplaceSpaces(filePath As String, fileName As String, newName As String)
    Dim inputFile As String
    Dim outputFile As String
    Dim fileContent As String
    Dim fileNum As Integer
    Const PLACE_HOLDER = "##"
    ' File paths
    inputFile = filePath & fileName
    outputFile = filePath & newName
    ' Open the input file for reading
    fileNum = FreeFile
    Open inputFile For Input As #fileNum
    fileContent = Input(LOF(fileNum), fileNum) ' Read the entire file
    Close #fileNum
    ' Replace 11 spaces with " ## "
    fileContent = Replace(fileContent, String(11, " "), Chr(32) & PLACE_HOLDER & Chr(32))
    ' Open the output file for writing
    fileNum = FreeFile
    Open outputFile For Output As #fileNum
    Print #fileNum, fileContent ' Write updated content to the new file
    Close #fileNum
End Sub

Output: