Separate string of text, based on dynamic 3-char, 4-char and spaces, into columns

Hi. Before we get going on this one...

Is your forum profile showing the Excel PRODUCT that you need this request to work with?

The best solutions often rely on knowing WHICH Office PRODUCT (Excel, NOT Windows) that you have. Please check that your forum profile is up-to-date. If you aren't sure, in Excel go to File/Account and report what it says below the MS logo at the top of that page. If your version is for Mac, please also state this.

The three most recent Excel PRODUCTS are Excel 2019, Excel 2021 and MS365 - if you are using MS365, please give this name along with the Version number in your profile (e.g. MS365 (PC) Version 2211). The version number is in the About Excel section further down the Account page.

Cheers,

Glenn.

If the roster codes were ALL 3 digits, it would hav ebeen reasonably easy. However, that IS an added complication!!

You forgot to add a list of roster codes. Please do so.

Another complication is that there is no space before the FIRST roster code.

Does it look the same if you paste special as unicode text ??

OK. 2202 is a bit unhelpful... 2209 would have been better. However, I have an idea which might work. I'll know better when I see your code list.

Sub Rotax()

Dim ar, arr, b, c, d
Sheets("Sheet1").Activate

ar = [A1].CurrentRegion
ReDim arr(1 To UBound(ar, 1), 1 To 30)
wCard = Array("DG1", "MG9", "MGL", "VP6", "VP9")
c = Range("Codes")
n = 0
For i = 1 To UBound(ar, 1)
    n = 1
    arr(i, n) = Left(ar(i, 1), 18)
    
    xstr = Trim(Mid(ar(i, 1), 19, 255))
    xstr = Replace(xstr, Chr(160), " ")  ' Replace Char(160) with blank
    xstr = Trim(xstr)                    ' Remove extraneous blanks
    xstr = Replace(xstr, " ", "*")       ' Replace blanks with "*"
    
    For j = 1 To UBound(c, 1)
        If Left(c(j, 1), 1) = "*" Then   ' Frre days
            cvalue = Replace(c(j, 1), "*", "X") & "|"  ' Replace "*" with "X" and add delimiter of "|"
        Else
            If Len(c(j, 1)) = 4 And c(j, 1) <> "OME1" Then                   ' Insert "?" into 3 position of 4 chaacter MG9 vs MG?O  (MG9O)
               res = Application.Match(Left(c(j, 1), 3), wCard, 0)
               cvalue = Left(c(j, 1), 2) & UCase(Chr(64 + res)) & Right(c(j, 1), 1)
            Else
             cvalue = c(j, 1)
            End If
     End If
     xstr = Replace(xstr, c(j, 1), "|" & cvalue)       ' Replace code with replacement plus delimiter
   
    Next j
    
    
    d = Split(xstr, "|")      ' Split by delimiter
    For j = 0 To UBound(d, 1)
        If d(j) <> "" Then
            If Left(d(j), 1) = "X" Then  ' Indicates spaces
                n = n + Len(d(j))        ' Increment "day" number
                d(j) = ""                ' Set day to blank
            Else
                n = n + 1
            End If
        arr(i, n) = Replace(Replace(Replace(Replace(Replace(d(j), "DGAO", "DG1O"), "MGBO", "MG9O"), "MGCO", "MGLO"), "VPDO", "VP6O"), "VPEO", "VP9O") '<<< needs coorection ??
       
        End If
    Next j

Next i
[A24].Resize(UBound(arr, 1), 30) = arr
End Sub