Sub SplitCodeDate()
Dim R As Long, X As Long, Cnt As Long, Data As Variant
[B][COLOR="#008000"] ' Put all the data into an array so that the code does not keep
' asking the worksheet for data (arrays are much faster than
' continually referencing cells on the worksheet directly). Since
' there will be two columns of data outputted, I resize the single
' column of data to two columns in the array in order to output
' the correct size data at the end.
[/COLOR][/B] Data = Range("A1", Cells(Rows.Count, "A").End(xlUp)).Resize(, 2)
[B][COLOR="#008000"] ' Examing the value in each cell
[/COLOR][/B] For R = 1 To UBound(Data)
[B][COLOR="#008000"] ' Cnt is used to count digits in a cell's value, so we want
' it set to zero before each individual cell is examined.
[/COLOR][/B] Cnt = 0
[B][COLOR="#008000"] ' While I assume Column B will be blank when I resized the range
' that I copied into the Data array originally, here I am making
' sure I did not accidentally pick up a value.
[/COLOR][/B] Data(R, 2) = ""
[B][COLOR="#008000"] ' This loop starts at the end of the text from the cell's value
' being examined and iterates toward the beginning of the text.
[/COLOR][/B] For X = Len(Data(R, 1)) To 1 Step -1
[B][COLOR="#008000"] ' If the digit count is less than 4 (remember, Cnt starts at 0),
' then we are still building the date value.
[/COLOR][/B] If Cnt < 4 Then
[B][COLOR="#008000"] ' If the character being examined is a digit, then concatenate
' it into the second dimension of the Data array.
[/COLOR][/B] If IsNumeric(Mid(Data(R, 1), X, 1)) Then
[B][COLOR="#008000"] ' Because we found a digit, increase the digit counter by one.
[/COLOR][/B] Cnt = Cnt + 1
[B][COLOR="#008000"] ' Concatenate the digit on to the front of the digits that
' have already been found (remember, we are iterating backwards).
[/COLOR][/B] Data(R, 2) = Mid(Data(R, 1), X, 1) & Data(R, 2)
End If
[B][COLOR="#008000"] ' Once Cnt is equal to 4, that means we have found all of the digits
' that make up the date value.
[/COLOR][/B] ElseIf Cnt = 4 Then
[B][COLOR="#008000"] ' We use VB's Format function to add the first day of the month to
' the date and place the slashes that the US date uses as its delimiter
' which is stored in the second dimension of the Data array.
[/COLOR][/B] Data(R, 2) = Format(Data(R, 2), "@@/01/@@")
[B][COLOR="#008000"] ' Incase there are no more digits in the text, all the remaining text
' is placed in the first dimension of the Data array.
[/COLOR][/B] Data(R, 1) = Left(Data(R, 1), X)
[B][COLOR="#008000"] ' Since Cnt will no longer be increased, we set it to a number so that
' the If and ElseIf statements above will not be triggered, that way
' the ElseIf statement below will handle the rest of the characters
' being examined from the cell's text.
[/COLOR][/B] Cnt = 5
[B][COLOR="#008000"] ' As soon as we come across a digit, we are done searching
[/COLOR][/B] ElseIf IsNumeric(Mid(Data(R, 1), X, 1)) Then
[B][COLOR="#008000"] ' All the text from the beginning of the text to the digit that was
' just found are assigned to the first dimension of the Data array.
[/COLOR][/B] Data(R, 1) = Left(Data(R, 1), X)
[B][COLOR="#008000"] ' Since we are done searching the cell's text, we exit this inner
' loop so that we can move on to the next cell's text.
[/COLOR][/B] Exit For
End If
Next
Next
[B][COLOR="#008000"] ' Now that all of the text in all of the cells of Column A have be processed,
' then first we format the cells in Column D as a Date
[/COLOR][/B] Range("D1").Resize(UBound(Data)).NumberFormat = "mm/dd/yyyy"
[B][COLOR="#008000"] ' then we place all of the data in Columns C and D (Column C gets the code,
' and Column D gets the date).
[/COLOR][/B] Range("C1").Resize(UBound(Data), 2) = Data
End Sub
