How to vba to split data to their respective columns with character restriction

How to create VBA to split data to their respective columns with character restriction

Requirement:

The user received merged description that need to be break into three fields.The columns are then uploaded as csv format

Columns A represent the merge description that need to be broken into their respective columns but the issue come from column C,where characters are limited to 32 characters.(red )

The user wants to break down column C into two columns parts.

Expected results are in yellow.

Formulas used in column B, C and D but when column C is more 32 characters, the user needs to cut and paste manually which is painful with 10000 rows of data daily.

https://www.ozgrid.com/forum/forum/help-forums/excel-vba-macros/148555-vba-to-split-data-to-their-respective-columns-with-character-restriction

Solution:

Code:

Option Explicit
 
Sub Split_And_Save_As_CSVTT()
    Dim x, y(), z, s, i As Long, ii As Long, iii As Integer
    Dim sPath As String, sFileName As String, sFullName As String
     
    sFileName = "Name of CSV File" '// Change name of CSV file to suit
     
    sPath = ThisWorkbook.Path '// Change to required path if not same as this workbook
     
    If Right(sPath, 1) <> Application.PathSeparator Then
        sFullName = sPath & Application.PathSeparator & sFileName & ".csv"
    Else
        sFullName = sPath & sFileName & ".csv"
    End If
     
    x = Sheets("break ").UsedRange.Columns(1)
    ReDim y(1 To UBound(x, 1) - 1, 3)
     
    For i = 2 To UBound(x, 1)
        z = Split(x(i, 1))
        y(i - 1, 0) = z(0)
        For ii = 1 To UBound(z) - 2
            If ii = 1 Then
                y(i - 1, 1) = z(ii)
            Else
                y(i - 1, 1) = y(i - 1, 1) & " " & z(ii)
            End If
        Next
        If Len(y(i - 1, 1)) > 32 Then
            If InStr(y(i - 1, 1), "(") > 0 Then
                s = Split(y(i - 1, 1), ")")
                y(i - 1, 1) = Trim(s(0)) & ")"
                y(i - 1, 2) = Trim(s(1))
                If Len(y(i - 1, 1)) > 32 Then
                    s = Split(y(i - 1, 1), "(")
                    y(i - 1, 1) = Trim(s(0))
                    If y(i - 1, 2) = "" Then
                        y(i - 1, 2) = "(" & Trim(s(1))
                    Else
                        y(i - 1, 2) = "(" & Trim(s(1)) & " " & y(i - 1, 2)
                    End If
                End If
            Else
                s = Split(y(i - 1, 1))
                y(i - 1, 1) = ""
                For ii = 0 To UBound(s)
                    If Len(y(i - 1, 1)) + Len(s(ii)) < 33 Then
                        If ii = 0 Then
                            y(i - 1, 1) = s(ii)
                        Else
                            y(i - 1, 1) = y(i - 1, 1) & " " & s(ii)
                        End If
                    Else
                        If y(i - 1, 2) = "" Then
                            y(i - 1, 2) = s(ii)
                        Else
                            y(i - 1, 2) = y(i - 1, 2) & " " & s(ii)
                        End If
                    End If
                Next
            End If
        End If
        y(i - 1, 3) = z(UBound(z) - 1)
    Next
     
    Application.ScreenUpdating = 0
    With Sheets("Split_Data")
        .UsedRange.Offset(1).Clear
        .[a2].Resize(UBound(y, 1), 4) = y
        .Columns.AutoFit
        Application.DisplayAlerts = False
        .Copy
        ActiveWorkbook.SaveAs sFullName, 6
        ActiveWorkbook.Close
        Application.DisplayAlerts = True
         
    End With
     
End Sub

Obtained from the OzGrid Help Forum.

Solution provided by KjBox.