How to split a content from a cell in excel

Question

I am wondering how to take out the date part from the content and split both the code and date to separate columns. I will show you guys an example

Column A
Orient / 21/Dec / 30-12-2020
TechSol/8 / 1-1-2021
Orient / 12/Jan / 1-10-2021
AE-003 / 13-1-2021

I want to get the results like this:

B column	C column
Orient / 21/Dec	30-12-2020
TechSol/8	1-1-2021
Orient / 12/OCT	1-10-2021
AE-003	13-1-2021

the format of the combined cell is always like Code / Date, that is code is always separated from a date with <space> dash <space>. I am unable to figure out a way to separate them. When I use text to the column with character as / such dash are also present in the code. But I use fixed-width option it still doesn't work for me, as these are all different widths. using the formula =right is not working for me because the date format is not always in a fixed format, for example, 10 October will be in dd-mm-yyyy but single-digit month or day will be in the format d-m-yyyy so the character length is not also fixed.

I hope you all understood my issue. I need a formula to split these into different columns.

Answer 1

I have found the answer to my problem. All I wanted to do what a reverse search to find the last / to extract the date which was variable and substitute the date to the first cell to delete that.

=IF(ISERROR(FIND(" / ",A1)),A1,RIGHT(A1,LEN(A1)-FIND("~",SUBSTITUTE(A1," ","~",LEN(A1)-LEN(SUBSTITUTE(A1," ",""))))))

Answer 2

Tiny variant using ReDim

For the sake of the art, I demonstrate a tiny variant to @FaneDuru 's valid answer (and can be called the same way).

This approach needs the following steps:

• split the string passed as argument thus resulting in an array a with up to three elements,
• remember the last element (identified via the Ubound() function) and assign it to b,
• redimension array a via ReDim Preserve thus removing the last element (instead of a negative filtering),
• return a function result as array comprising the joined elements of array a as well as the remembered element b.

Function SplitText(s As String) As Variant
'[0]split string
    Dim a, b, ubnd As Long
    a = Split(s, "/ "): ubnd = UBound(a)
    b = a(ubnd)
'[1]redimension array a
    ReDim Preserve a(IIf(ubnd = 1, 0, 1))
'[2]return results
    SplitText = Array(Join(a, "/"), b)
End Function

Answer 3

Given the examples you show:

• Col B: Return up to the last / in the string

• Col C: Return all after the last <space> in the string

    B1:  =LEFT(A1,FIND(CHAR(1),SUBSTITUTE(A1,"/",CHAR(1),LEN(A1)-LEN(SUBSTITUTE(A1,"/",""))))-1)
    C1:  =TRIM(RIGHT(SUBSTITUTE(A1," ",REPT(" ",99)),99))
  

Answer 4

Split by the Last Occurrence

Option Explicit

Sub splitByLastOccurrence()
    
    Const sName As String = "Sheet1"
    Const sFirst As String = "A1"
    
    Const dName As String = "Sheet1"
    Const dFirst As String = "B1"
    
    Const Delimiter As String = " / "
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code

    ' Attempt to define (one-column) Source Range.
    Dim rg As Range
    Dim isRangeDefined As Boolean
    With wb.Worksheets(sName).Range(sFirst)
        Set rg = .Resize(.Worksheet.Rows.Count - .Row + 1) _
            .Find("*", , xlFormulas, , , xlPrevious)
        If Not rg Is Nothing Then
            Set rg = .Resize(rg.Row - .Row + 1)
            isRangeDefined = True
        End If
    End With
    
    If isRangeDefined Then
        
        ' Write (one-column) Source Range to (one-column) Data Array.
        Dim rCount As Long: rCount = rg.Rows.Count
        Dim Data As Variant
        If rCount = 1 Then
            ReDim Data(1 To 1, 1 To 1): Data(1, 1) = rg.Value
        Else
            Data = rg.Value
        End If
        ReDim Preserve Data(1 To rCount, 1 To 2) ' increase by one column
        
        Dim i As Long
        Dim Pos As Long
        Dim cString As String
        
        ' Write result to (two-column) Data Array.
        For i = 1 To rCount
            If Not IsError(Data(i, 1)) Then
                cString = Data(i, 1)
                Pos = InStrRev(cString, Delimiter)
                If Pos > 0 Then
                    Data(i, 1) = Left(cString, Pos - 1)
                    Data(i, 2) = Right(cString, _
                        Len(cString) - Pos - Len(Delimiter) + 1)
                End If
            End If
        Next i
        
        ' Write values from (two-column) Data Array
        ' to (two-column) Destination Range.
        With wb.Worksheets(dName).Range(dFirst).Resize(, 2)
            .Resize(rCount).Value = Data
            .Resize(.Worksheet.Rows.Count - .Row - rCount + 1) _
                .Offset(i - 1).ClearContents
        End With
    'Else
        ' No range.
    End If

End Sub

Answer 5

Please, try the next function:

Function SplitTEXT(x As String) As Variant
   Dim arr, sec As String
   arr = Split(x, "/ "): sec = arr(UBound(arr))        'split and memorize he last array element (date)
   arr(UBound(arr)) = "###$" & arr(UBound(arr)) 'add a unusual string to the last array element
                                                                   'in order to easily and faster replace it in the next line
    'Create an array from joined array elements after replacing the last one and the last (memorized) element (date):
   SplitTEXT = Array(Join(Filter(arr, arr(UBound(arr)), False), "/ "), sec)
End Function

It can be tested for all your example strings in the next way:

Sub testSplitTEXT()
    Dim x As String, arr
    x = "Orient / 21/Dec / 30-12-2020"
    'x = "TechSol/8 / 1-1-2021"
    'x = "Orient / 12/Jan / 1-10-2021"
    'x = "AE-003 / 13-1-2021"
    
    arr = SplitTEXT(x)
    Debug.Print arr(0), arr(1)
    Range("B1:C1").value = arr
End Sub

You must only uncomment the x = ... lines...

Or, use the next way to iterate between each A:A column values and split as you requested (on B:C columns):

Sub testSplitTIteration()
  Dim i As Long, sh As Worksheet, lastR As Long
  
  Set sh = ActiveSheet
  lastR = sh.Range("A" & sh.rows.count).End(xlUp).row
  For i = 2 To lastR
    sh.Range("B" & i & ":C" & i).value = SplitTEXT(sh.Range("A" & i).value)
  Next
End Sub