VBA code Split string error when Name is 1 month

[Excelpromax123]

Hi everyone, I have used the code below to split a string into an area. But when the string has the name of a month (from 1 to 12 ), when it appears it is a number. I want the output to remain the same as the original name. For example: August-1 -> August-1 (Currently error August-1 -> 45139 ). Thank you

Input test:

April / August-1 / AAA / December / BBB-1 / June-1 / June-2 / January / August-2 / August-3 / BBB-2 / February / June-3 / June-4 / June-5 /

Sub codeteset()
    On Error Resume Next
    Range("d4:d1000").ClearContents
    Dim arr(1 To 1000, 1 To 1), Tmp, Tem, Str As String
    Dim I As Long, J As Long, K As Long, c As Long, Col As Long
    Str = Range("d2").Value  ' input
    Tmp = Split(Str, " / "): c = UBound(Tmp): K = 1
    For I = 0 To c
        Tem = Split(Tmp(I), "*"): Col = 1
        For J = 0 To 1
            arr(K, Col) = Tem(J)
            Col = Col + 1
        Next J
        If Col > 1 Then
            Col = 1: K = K + 1
        End If
    Next I
    Range("d4").Resize(K, 1) = arr 'output
End Sub

 

[Fluff]

Try

With Range("d4").Resize(K, 1)
    .Numberformat = "@"
    .Value = arr
End With

 

[Snakehips]

@Excelpromax123 Was thinking similar tp @Fluff but will format the whole range of potential.
Not sure if it is typical but have added a final space to input string to prevent the last string being returned as "June-5 /"

Sub codeteset()
    On Error Resume Next
    Range("d4:d1000").ClearContents
    Range("d4:d1000").NumberFormat = "@"   '<<<<<<<
    Dim arr(1 To 1000, 1 To 1), Tmp, Tem, Str As String
    Dim I As Long, J As Long, K As Long, c As Long, Col As Long
    Str = Range("d2").Value & " "  ' <<<<<<<<  added space ???????
    Tmp = Split(Str, " / "): c = UBound(Tmp): K = 1
    For I = 0 To c
        Tem = Split(Tmp(I), "*"): Col = 1
        For J = 0 To 1
           arr(K, Col) = Tem(J)
            Col = Col + 1
        Next J
        If Col > 1 Then
            Col = 1: K = K + 1
        End If
    Next I
    Range("d4").Resize(K, 1) = arr 'output
End Sub

 

[Excelpromax123]

@Excelpromax123 Was thinking similar tp @Fluff but will format the whole range of potential.
Not sure if it is typical but have added a final space to input string to prevent the last string being returned as "June-5 /"

Sub codeteset()
    On Error Resume Next
    Range("d4:d1000").ClearContents
    Range("d4:d1000").NumberFormat = "@"   '<<<<<<<
    Dim arr(1 To 1000, 1 To 1), Tmp, Tem, Str As String
    Dim I As Long, J As Long, K As Long, c As Long, Col As Long
    Str = Range("d2").Value & " "  ' <<<<<<<<  added space ???????
    Tmp = Split(Str, " / "): c = UBound(Tmp): K = 1
    For I = 0 To c
        Tem = Split(Tmp(I), "*"): Col = 1
        For J = 0 To 1
           arr(K, Col) = Tem(J)
            Col = Col + 1
        Next J
        If Col > 1 Then
            Col = 1: K = K + 1
        End If
    Next I
    Range("d4").Resize(K, 1) = arr 'output
End Sub

Thank you !