Counting the position of a character after two or more spaces

Question

I am trying to return a value equal to the position of the first letter coming after two or more spaces.

I have a tool that extract tables with variable column length into TXT docs. I need to get these tables into an Excel sheet without having to put fixed width to each column in each table (that is a lot of coding to be done). I am trying to find something more dynamic to do so based on the position of the first character after two or more spaces.

Bearing in mind that not all rows are fully populated but the first row would make a perfect candidate to get the width of the column.

To give an example, the lines of the text would look like this

John       Robert       Eric       Tom

10          11            143        43

21                       265        56

99          241                     76

All I got so far is to make it work with fixed width as per the code below

Sub exporttosheet()

Dim fPath As String
fPath = "C:\test.txt"

Const fsoForReading = 1
Const F_LEN_A As Integer = 10
Const F_LEN_B As Integer = 23
Const F_LEN_C As Integer = 7
Const F_LEN_D As Integer = 10

Dim objFSO As Object, objTextStream As Object, txt, f1, f2, f3, f4
Dim start As Integer
Dim fLen As Integer
Dim rw As Long

Set objFSO = CreateObject("scripting.filesystemobject")
Set objTextStream = objFSO.OpenTextFile(fPath, fsoForReading)
rw = 1

Do Until objTextStream.AtEndOfStream
    txt = objTextStream.Readline


    f1 = Trim(Left(txt, F_LEN_A))
    start = F_LEN_A + 1
    f2 = Trim(Mid(txt, start, F_LEN_B))
    start = start + F_LEN_B + 1
    f3 = Trim(Mid(txt, start, F_LEN_C))
    start = start + F_LEN_C + 1
    f4 = Trim(Mid(txt, start, F_LEN_D))

    With ThisWorkbook.Sheets("data").Cells(rw, 1).Resize(1, 4)
        .NumberFormat = "@" 'format cells as text
        .Value = Array(f1, f2, f3, f4)
    End With
    rw = rw + 1
Loop

objTextStream.Close
End Sub

Answer 1

In lieu of any confirmation from you, I am going to assume that there actually is unicode characters in your actual data.

Option Explicit

Sub Split_My_Data()
    Dim s As Long, str As String, tmp As Variant, varFieldInfo As Variant

    ReDim tmp(0 To 0)

    With Worksheets("Sheet3")
        str = .Cells(1, 1).Value2
        s = Application.Max(InStrRev(str, Chr(32)), _
                            InStrRev(str, ChrW(8194)))
        Do While CBool(s)
            tmp(UBound(tmp)) = Array(s, 1)
            str = Left(str, s)
            Do While Right(str, 1) = Chr(32) Or Right(str, 1) = ChrW(8194): str = Left(str, Len(str) - 1): Loop
            s = Application.Max(InStrRev(str, Chr(32)), _
                                InStrRev(str, ChrW(8194)))
            ReDim Preserve tmp(LBound(tmp) To UBound(tmp) + 1)
            If Not CBool(s) Then Exit Do
        Loop

        'make the last (first) fieldinfo element
        tmp(UBound(tmp)) = Array(0, 1)

        'make room for the reversed fieldinfo
        ReDim varFieldInfo(LBound(tmp) To UBound(tmp))

        'reverse the fieldinfo array
        For s = UBound(tmp) To LBound(tmp) Step -1
            varFieldInfo(UBound(tmp) - s) = tmp(s)
        Next s

        'run TextToColumns with the new array of arrays for FieldInfo
        .Columns("A:A").TextToColumns Destination:=.Cells(1, "A"), DataType:=xlFixedWidth, FieldInfo:=varFieldInfo

        For s = 1 To .Cells(1, .Columns.Count).End(xlToLeft).Column
            With Intersect(.Columns(s), .UsedRange).Cells
                'get rid of unicode
                .Replace what:=ChrW(8194), replacement:=vbNullString, lookat:=xlPart
                'use another texttocolumns as a fast Trim
                .TextToColumns Destination:=.Cells(1, "A"), DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 1))
                'shrink/expand the column
                .EntireColumn.AutoFit
                .EntireColumn.ColumnWidth = Application.Max(.ColumnWidth, 9)
            End With
        Next s
    End With
End Sub

Results with text as trimmed text and numbers as real numbers (no unicode):