vba code require to separate date from code

[VBABEGINER]

Hi All,

I need a vba code, where I can split range value in code and date.

This are the values in Col A.

[TABLE="width: 150"]
<colgroup><col></colgroup><tbody>[TR]
[TD]CGU 002 - 05/89[/TD]
[/TR]
[TR]
[TD]ECG 21 501 - 05/00[/TD]
[/TR]
[TR]
[TD]ECG 21 762 - 04/14[/TD]
[/TR]
[TR]
[TD]CG 21 73 - 01/00[/TD]
[/TR]
[TR]
[TD]CG 21 06 - 05/14[/TD]
[/TR]
[TR]
[TD]CG 21 35 - 10/01[/TD]
[/TR]
[TR]
[TD]CG 21 47 - 12/07[/TD]
[/TR]
[TR]
[TD]CG 21 54 - 01/96[/TD]
[/TR]
[TR]
[TD]CG 21 55 - 09/99[/TD]
[/TR]
[TR]
[TD]CG 21 86 - 12/04[/TD]
[/TR]
[TR]
[TD]CG 21 96 - 03/05[/TD]
[/TR]
[TR]
[TD]CG 22 34 - 04/13[/TD]
[/TR]
[TR]
[TD]CG 22 43 - 04/13[TABLE="width: 150"]
<colgroup><col></colgroup><tbody>[TR]
[TD]CGU 002 - 05/89[/TD]
[/TR]
[TR]
[TD]ECG 21 501 - 05/00[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[/TR]
</tbody>[/TABLE]

Here, "05/89" these are dates. I want, "CGU 002" these in A range and "05/89" these in B Col with addition of "05/01/89"..

Can some one pls help..

 

[VBABEGINER]

Ohh, my apologies. This is I made some wrong typing...Please ignore that..and can we do for rest types...

The last 4 digits? What are the last 4 digits for these two examples that you posted in Message #6 ...

IL T8 25

MCS 90

 

[VBABEGINER]

Hi, can we do something on this. ...solution for multiple condition pls

 

[VBABEGINER]

Hi,
Could you pls help me in this..How do I amend multiple condition..

For iFrmNo1 = 3 To Range("B" & Rows.Count).End(xlUp).Row
If myArray1 = Split(ActiveSheet.Range("B" & iFrmNo1).Value, " - ") Then
myDate1 = myArray1(UBound(myArray1))
myInfo1 = myArray1(LBound(myArray1))
With ActiveSheet
.Range("B" & iFrmNo1).Value = myInfo1
.Range("C" & iFrmNo1).Value = myDate1
.Range("C" & iFrmNo1).NumberFormat = "m/d/yyyy"
End With
Else
If myArray1 = Split(ActiveSheet.Range("B" & iFrmNo1).Value, " Ed. ") Then
myDate1 = myArray1(UBound(myArray1))
myInfo1 = myArray1(LBound(myArray1))
With ActiveSheet
.Range("B" & iFrmNo1).Value = myInfo1
.Range("C" & iFrmNo1).Value = myDate1
.Range("C" & iFrmNo1).NumberFormat = "m/d/yyyy"
End With
End If
Next iFrmNo1

Try:

This is saying there is no header row (if header, change i = 2)

Sub Test()

    For i = 1 To Range("A" & Rows.Count).End(xlUp).Row
        myArray = Split(ActiveSheet.Range("A" & i).Value, " - ")
        myDate = myArray(UBound(myArray))
        myInfo = myArray(LBound(myArray))
            With ActiveSheet
                .Range("A" & i).Value = myInfo
                .Range("B" & i).Value = myDate
                .Range("B" & i).NumberFormat = "m/d/yyyy"
            End With
    Next i

End Sub

 

[VBABEGINER]

Dear Sir, any solution for this please...how to amend multiple condition..

Try:

This is saying there is no header row (if header, change i = 2)

Sub Test()

    For i = 1 To Range("A" & Rows.Count).End(xlUp).Row
        myArray = Split(ActiveSheet.Range("A" & i).Value, " - ")
        myDate = myArray(UBound(myArray))
        myInfo = myArray(LBound(myArray))
            With ActiveSheet
                .Range("A" & i).Value = myInfo
                .Range("B" & i).Value = myDate
                .Range("B" & i).NumberFormat = "m/d/yyyy"
            End With
    Next i

End Sub

 

[VBABEGINER]

Hi Rick Sir,
Looking for your suggestion sir..Could you please suggest me on my below code..confused..not solving..

Dim myRange As Integer
Dim myCell As Integer
myRange = Range("B" & Rows.Count).End(xlUp).Row
For myCell = 3 To myRange
If myCell Like "* - *" Then 'example= ABC 002 - 05/89
myCell.Replace " - ", Chr(1), xlPart, , , , False, False
myCell.Replace "/", "/01/", xlPart, , , , False, False
myCell.TextToColumns , xlDelimited, , , False, False, False, False, True, Chr(1)
Else
If myCell Like "* Ed. *" Then 'example= ABC-19076 Ed. 01-16
myCell.Replace " Ed. ", Chr(1), xlPart, , , , False, False
myCell.Replace "/", "/01/", xlPart, , , , False, False
myCell.TextToColumns , xlDelimited, , , False, False, False, False, True, Chr(1)
Else
If myCell Like "* *" Then 'example= ABC-7007 08/11
myCell.Replace "/", "/01/", xlPart, , , , False, False
myCell.TextToColumns , xlDelimited, , , False, False, False, False, True, Chr(1)
Else
' If Not myCell Like "* *" Then 'example= ABC8011093
' frmlR = Right(myCell, 4)
' frmlR_mm = Left(frmlR, Len(frmlR) - 2) '...2
' frmlR_yy = Right(myCell, 2) '...3
' frmlL = Left(myCell, Len(myCell) - 4) '...1
' newCell = frmlL & " a1 " & frmlR_mm & "/" & frmlR_yy
' myCell = newCell
' myCell.Replace " a1 ", Chr(1), xlPart, , , , False, False
' myCell.Replace "/", "/01/", xlPart, , , , False, False
' myCell.TextToColumns , xlDelimited, , , False, False, False, False, True, Chr(1)
' Else
frmlSb = Application.WorksheetFunction.Substitute(myCell, " ", "")
frmlR1 = Right(myCell, 4)
frmlR1_mm = Left(frmlR1, Len(frmlR1) - 2) '...2
frmlR1_yy = Right(myCell, 2) '...3
frmlL1 = Left(myCell, Len(myCell) - 4) '...1
newCell_1 = frmlL1 & " a2 " & frmlR1_mm & "/" & frmlR1_yy
myCell = newCell_1
myCell.Replace " a2 ", Chr(1), xlPart, , , , False, False
myCell.Replace "/", "/01/", xlPart, , , , False, False
myCell.TextToColumns , xlDelimited, , , False, False, False, False, True, Chr(1)
End If
End If
End If
'End If
Next myCell

Here is another macro that you can try...

[TABLE="width: 500"]
<tbody>[TR]
[TD]Sub Test()
  Columns("A").Replace " - ", Chr(1), xlPart, , , , False, False
  Columns("A").Replace "/", "/01/", xlPart, , , , False, False
  Columns("A").TextToColumns , xlDelimited, , , False, False, False, False, True, Chr(1)
  Columns("B").NumberFormat = "mm/dd/yyyy"
End Sub[/TD]
[/TR]
</tbody>[/TABLE]

Note: This code will work even if your data has headers in Row 2 as long as the header text does not have a dash surrounded by spaces nor a forward slash in it.

 

[VBABEGINER]

The last 4 digits? What are the last 4 digits for these two examples that you posted in Message #6 ...

IL T8 25

MCS 90

Dear Sir,
Need help on the same, please..

 

[D3allamerican07]

Since I don't know all the possible combinations, something like this could work. Try it and let me know where issues are.

Sub Test()

    For I = 1 To Range("A" & Rows.Count).End(xlUp).Row
        'For cell format CGU 002 - 05/89
        If InStr(1, Range("A" & I).Value, " - ") Then
            Range("A" & I).Replace " - ", Chr(1), xlPart, , , , False, False
            Range("A" & I).Replace "/", "/01/", xlPart, , , , False, False
            Range("A" & I).TextToColumns , xlDelimited, , , False, False, False, False, True, Chr(1)
            Range("A" & I).NumberFormat = "mm/dd/yyyy"
                  
        'For cell format LIA-7139 Ed. 01-09
        ElseIf InStr(1, Range("A" & I).Value, "Ed.") Then
            myArray = Split(ActiveSheet.Range("A" & I).Value, "Ed.")
            myDate = myArray(UBound(myArray))
            myDate = Replace(myDate, "-", "/01/")
            myInfo = myArray(LBound(myArray))
                With ActiveSheet
                    .Range("A" & I).Value = myInfo & "Ed."
                    .Range("B" & I).Value = myDate
                    .Range("B" & I).NumberFormat = "mm/dd/yyyy"
                End With

        'For cell format IL T8 01 10 93
        ElseIf InStr(1, Range("A" & I).Value, "T8") Then
            myArray = Split(ActiveSheet.Range("A" & I).Value, "01")
            myDate = myArray(UBound(myArray))
            If Left(myDate, 1) = " " Then
                myDate = Right(myDate, Len(myDate) - 1)
                myDate = Replace(myDate, " ", "/01/")
            Else
                myMonth = Left(myDate, 2)
                myYear = Right(myDate, 2)
                myDate = myMonth & "/01/" & myYear
            End If
                myInfo = myArray(LBound(myArray))
                With ActiveSheet
                    .Range("A" & I).Value = myInfo & "01"
                    .Range("B" & I).Value = myDate
                    .Range("B" & I).NumberFormat = "mm/dd/yyyy"
                End With
                
        'For cell format ACF-7007 08/11
        ElseIf InStr(1, Range("A" & I).Value, "7007 ") Then
            myArray = Split(ActiveSheet.Range("A" & I).Value, "7007 ")
            myDate = myArray(UBound(myArray))
            myDate = Replace(myDate, "/", "/01/")
            myInfo = myArray(LBound(myArray))
                With ActiveSheet
                    .Range("A" & I).Value = myInfo & "7007"
                    .Range("B" & I).Value = myDate
                    .Range("B" & I).NumberFormat = "mm/dd/yyyy"
                End With
               
        'For cell format MM99561013
        ElseIf InStr(1, Range("A" & I).Value, "MM9956") Then
            myArray = Split(ActiveSheet.Range("A" & I).Value, "9956")
            myDate = myArray(UBound(myArray))
            If Left(myDate, 1) = "" Then
                myDate = Right(myDate, Len(myDate) - 1)
                myDate = Replace(myDate, " ", "/01/")
            Else
                myMonth = Left(myDate, 2)
                myYear = Right(myDate, 2)
                myDate = myMonth & "/01/" & myYear
            End If
            myInfo = myArray(LBound(myArray))
                With ActiveSheet
                    .Range("A" & I).Value = myInfo & "9956"
                    .Range("B" & I).Value = myDate
                    .Range("B" & I).NumberFormat = "mm/dd/yyyy"
                End With
        End If
    Next I

End Sub

 

[Rick Rothstein]

See if this macro does what you want...

[table="width: 500"]
[tr]
	[td]Sub SplitCodeDate()
  Dim R As Long, X As Long, Cnt As Long, Data As Variant
  Data = Range("A1", Cells(Rows.Count, "A").End(xlUp)).Resize(, 2)
  For R = 1 To UBound(Data)
    Cnt = 0
    Data(R, 2) = ""
    For X = Len(Data(R, 1)) To 1 Step -1
      If Cnt < 4 Then
        If IsNumeric(Mid(Data(R, 1), X, 1)) Then
          Cnt = Cnt + 1
          Data(R, 2) = Mid(Data(R, 1), X, 1) & Data(R, 2)
        End If
      ElseIf Cnt = 4 Then
        Data(R, 2) = Format(Data(R, 2), "@@/01/@@")
        Data(R, 1) = Left(Data(R, 1), X)
        Cnt = 5
      ElseIf IsNumeric(Mid(Data(R, 1), X, 1)) Then
        Data(R, 1) = Left(Data(R, 1), X)
        Exit For
      End If
    Next
  Next
  Range("D1").Resize(UBound(Data)).NumberFormat = "mm/dd/yyyy"
  Range("C1").Resize(UBound(Data), 2) = Data
End Sub[/td]
[/tr]
[/table]

 

[VBABEGINER]

HI D3,
Thank you so much, for your reply. I truly appreciated your reply, and thnks you o helping me tough situation.
God bless you..

 

[VBABEGINER]

Speechless...

From last 2 hours, I am still not understand how express my self on your solution.. A simple Thank You Sir. Really Thanks, for helping me, guiding me in my tough situation..

some words for you...I really don't understand, how you all so high level of Experts..!!! How come you understand this are form no and date's...

This is an Excellent...and High benchmark for me..
Thank You so so much, and bless you with lot of wealth prosperity...

Sir, Final one...Pls explain me how this is working...line by line pls...I really not understand...

See if this macro does what you want...

[TABLE="width: 500"]
<tbody>[TR]
[TD]Sub SplitCodeDate()
  Dim R As Long, X As Long, Cnt As Long, Data As Variant
  Data = Range("A1", Cells(Rows.Count, "A").End(xlUp)).Resize(, 2)
  For R = 1 To UBound(Data)
    Cnt = 0
    Data(R, 2) = ""
    For X = Len(Data(R, 1)) To 1 Step -1
      If Cnt < 4 Then
        If IsNumeric(Mid(Data(R, 1), X, 1)) Then
          Cnt = Cnt + 1
          Data(R, 2) = Mid(Data(R, 1), X, 1) & Data(R, 2)
        End If
      ElseIf Cnt = 4 Then
        Data(R, 2) = Format(Data(R, 2), "@@/01/@@")
        Data(R, 1) = Left(Data(R, 1), X)
        Cnt = 5
      ElseIf IsNumeric(Mid(Data(R, 1), X, 1)) Then
        Data(R, 1) = Left(Data(R, 1), X)
        Exit For
      End If
    Next
  Next
  Range("D1").Resize(UBound(Data)).NumberFormat = "mm/dd/yyyy"
  Range("C1").Resize(UBound(Data), 2) = Data
End Sub[/TD]
[/TR]
</tbody>[/TABLE]