convert first 6 digits into date

[tracktraining]

Hi Everyone,

I have a column that contains serial numbers in this format - mmddyy - ###
(i.e. 060308-001).
I would like to split out the first 6 digits and convert it into a date
(mm/dd/yy).
I tried to do this with the following code and it doesn't work:

'------start code

startserial = Format(Me.Start_Serial, "mm/dd/yy")
endserial = Format(Me.End_Serial, "mm/dd/yy")

For Each SerialRng In SerialRng.cells
myserial = Left(SerialRng.cells(SerialRng.row, 4), 6)
record_serial = Format(myserial, "mm/dd/yy")
On Error Goto Next SerialRng ***(see note below)
If record_serial >= startserial And record_serial <= endserial Then
SerialRng.EntireRow.Copy
Sheets("Data").Select
cells(Rows.count, 1).End(xlUp)(2).Select
Selection.PasteSpecial Paste:=xlAll
End If
Next SerialRng

'---- end code

***here I would like for it to skip to the next SerialRng if cannot get the
first 6 digit to convert into a date - sometimes the field may not be a
serial number and just some other ID number so it can't be converted into a
date.

Please help if possible.


Thank you!
tracktraining

 

[Joel]

For Each SerialRng In SerialRng.cells
myserial = Left(SerialRng.cells.offset, 6)
record_serial = DateSerial(mid(myserial,5,2),
Left(Myserial,2),mid(myserial,3,2) )
On Error Goto Next SerialRng ***(see note below)
If record_serial >= startserial And record_serial <= endserial Then
SerialRng.EntireRow.Copy
Sheets("Data").Select
cells(Rows.count, 1).End(xlUp)(2).Select
Selection.PasteSpecial Paste:=xlAll
End If
Next SerialRng

 

[tracktraining]

the code is erroring out at this location:
record_serial = DateSerial(mid(myserial,5,2),
Left(Myserial,2),mid(myserial,3,2) )

During these two lines (see below), i am trying to 1.) read the first 6
digits then 2.) convert to format mm/dd/yy. Maybe it would help if i told you
that the serial number is in column is D.

myserial = Left(SerialRng.cells(SerialRng.row, 4), 6)
record_serial = Format(myserial, "mm/dd/yy")

thanks!

 

[Joel]

The offset satement was wrong. the code below should work. I create a set
statement so you can see how the code should work.

Set SerialRange = Range("A1:A10")
For Each SerialRng In SerialRange
myserial = Left(SerialRng.Offset(0, 3), 6)
record_serial = DateSerial(Mid(myserial, 5, 2), _
Left(myserial, 2), Mid(myserial, 3, 2))
Next SerialRng

 

[Patrick Molloy]

the date is
Dim mydate As Date
mydate = DateSerial(Mid(Range("A1"), 5, 2), Mid(Range("A1"), 3, 2),
Left(Range("A1"), 2))

so for your loop

For Each SerialRng In SerialRng.cells
record_serial= Left(Range("A1"), 2) & "/" & Mid(Range("A1"), 3, 2) &
"/" & Mid(Range("A1"), 5, 2)
if isdate(record_serial) then
If record_serial >= startserial And record_serial <= endserial Then
SerialRng.EntireRow.Copy
Sheets("Data"). cells(Rows.count,
1).End(xlUp)(2).PasteSpecial Paste:=xlAll
End If
End If
Next

 

[Rick Rothstein]

Here is another method you can use to convert your serial numbers into real
dates...

MySerial = Left(Format(SerialRng, "@@/@@/@@"), 8)

This code line requires MySerial to be Dim'med as a Date (so that VB will
convert the String value on the right side into a real date. If you want to
force this conversion (instead of allowing VB to do the conversion behind
the scenes), then use this...

MySerial = CDate(Left(Format(SerialRng, "@@/@@/@@"), 8))

 

[Rick Rothstein]

Oh, and the statement I posted also assumes your regional settings are set
for dates in month, date, year order (so the mm/dd/yy ordering of the String
that results from my statement will be interpreted correctly).

 

[Mishell]

Sub Final()

'You must compare Dates with Dates, not Dates with Strings
'So forget the Format function if you want to compare dates

Dim startserial As Date

Dim endserial As Date

startserial = CDate(Me.Start_Serial)
endserial = CDate(Me.End_Serial)


For Each SerialRng In SerialRng.Cells
myserial = Left(Cells(SerialRng.Row, 4), 6)
YY = Mid(myserial, 5, 2)
MM = Left(myserial, 2)
DD = Mid(myserial, 3, 2)
record_serial = DateSerial(YY, MM, DD)

'On Error Goto Next SerialRng ***(see note below)
If record_serial >= startserial And record_serial <= endserial Then
SerialRng.EntireRow.Copy
Sheets("Data").Select
Cells(Rows.Count, 1).End(xlUp)(2).Select
Selection.PasteSpecial Paste:=xlAll
End If
Next SerialRng

End Sub

Mishell

 

[Rick Rothstein]

'You must compare Dates with Dates, not Dates with Strings
'So forget the Format function if you want to compare dates

If you place the output from a **properly constructed** Format function into
a Date variable, you will have a Date that can be used in a comparison with
other dates, so a general warning about staying away from the Format
function may be too strong a statement. In my response to the OP, I offered
this code line...

MySerial = Left(Format(SerialRng, "@@/@@/@@"), 8)

which uses the Format statement as its basis and which works fine (as long
as MySerial is Dim'med as a Date). By the way, another way to write this
statement (so that it looks like a "true" Format statement) is this way...

MySerial = Format(Left(SerialRng, 6), "@@/@@/@@")

and, as long as MySerial is Dim'med as a Date, it would work fine too. If
the OP wanted to do the comparisons directly, without using a variable
Dim'med as a Date, the you would simply wrap the output from the Format
function with a CDate function call. For example, something like this...

If CDateFormat(Left(SerialRng, 6), "@@/@@/@@")) = OtherDate Then

 

[Mishell]

Thank you Rick.

I did not know that the FORMAT function could do this, transform
060308 to 06/03/08

Mishell

 

[Rick Rothstein]

Just to be clear, the Format function returns the String value "06/03/08"
and the assignment to the Date variable, or alternately wrapping it in the
CDate function, is what converts that String value into a Date value.

--
Rick (MVP - Excel)

Thank you Rick.

I did not know that the FORMAT function could do this, transform
060308 to 06/03/08

Mishell

 

[tracktraining]

i tried this and it is erroring out at

record_serial = DateSerial(Mid(myserial, 5, 2), _
Left(myserial, 2), Mid(myserial, 3, 2))

when i put my cursor over the record_serial the data stored in it is 12:00 AM

 

[tracktraining]

I also tried this and also got an error:

error out at this line: recserial = Format(Left(SerialRng, 6), "@@/@@/@@")


my SerialRng is in this format when in the excel cell: 060308-001 (i.e.
mmddyy-###)



--- start code -----

dim recserial as date

With Worksheets("Complaint Log (2)")
Set SerialRng = .Range("D2", .cells(.Rows.count, "D").End(xlUp))
End With

For Each SerialRng In SerialRng.cells
recserial = Format(Left(SerialRng, 6), "@@/@@/@@")
If IsDate(recserial) Then
If recserial >= ss And recserial <= es Then
SerialRng.EntireRow.Copy
Sheets("Data").Select
Sheets("Data").cells(Rows.count,
1).End(xlUp)(2).PasteSpecial Paste:=xlAll
End If
End If
Next SerialRng

---- end code


thanks for helping out thus far

 

[Rick Rothstein]

Is recserial declared as a Date? If not, what is it declared as?

 

[tracktraining]

maybe it would help if you see my whole code:

Sub Starting_SerialRng(d1 As Date, d2 As Date, ss As Date, es As Date, p As
String)
Dim SerialRng As Range
Dim myserial As String
Dim recserial As Date

Sheets("Complaint Log (2)").Select
Columns("A:O").Select
Selection.AutoFilter
Selection.AutoFilter Field:=9, Criteria1:=">=" & d1 & "",
Operator:=xlAnd, Criteria2:="<=" & d2 & "", Operator:=xlAnd
Selection.AutoFilter Field:=5, Criteria1:="=*" & p & "*"

With Worksheets("Complaint Log (2)")
Set SerialRng = .Range("D2", .cells(.Rows.count, "D").End(xlUp))
End With

For Each SerialRng In SerialRng.cells
myserial = Left(SerialRng.Offset(0, 3), 6)
recserial = Format(myserial, "@@/@@/@@")
'recserial = Format(Left(SerialRng, 6), "@@/@@/@@")
'recserial = DateSerial(Mid(myserial, 5, 2), Left(myserial, 2),
Mid(myserial, 3, 2))
If IsDate(recserial) Then
If recserial >= ss And recserial <= es Then
SerialRng.EntireRow.Copy
Sheets("Data").Select
Sheets("Data").cells(Rows.count,
1).End(xlUp)(2).PasteSpecial Paste:=xlAll
End If
End If
Next SerialRng

End Sub

 

[tracktraining]

as date...

please see my posting below.. i copied my whole sub into it .

Thanks!

 

[Rick Rothstein]

Showing us your code is always helpful. Off the top of my head (and in my
tests), I don't see why you should be erroring out on this line...

recserial = Format(Left(SerialRng, 6), "@@/@@/@@")

The only thing I can think of is that the contents of the cell is not in the
form you showed us (######-###)... that is, I suspect either one or more
leading spaces OR the number in the cell is actually ######### and you have
it Custom Formatted as 000000-000. Is either of these the case? If so, tell
me which and I will adjust the code accordingly. If not, then tell us what
the exact error message that you are getting is.

 

[tracktraining]

yes you are correct. Sometime the field is ######### (the amount of digit
varies)... i would like the code to skip over the field that is not in this
format ######-###.

Also, when i filter the data, the cells should now be consistent. for
example, if i filter it for a certain customer, then the serial number format
in the Serial Column should be ######-### or #######(digit varies). Right now
i am only looking at the serial number for ######-### (after filtering).

i hope that make sense.

 

[tracktraining]

Hi everyone,

I am still unable to figure this out. Were you able to figure out something?
or any sugguestions? Any help will do.

Thanks,
Tracktraining

 

[Patrick Molloy]

i thought this was all over.

The code below parses a selection of cells - you can easily adapt i t- and
where a cel's contents match the pattern ######-??? the date i sput into the
cell to it's right and the bit after the date is in the next cell

Option Explicit
Sub demo()
Dim cell As Range
For Each cell In Range("C4:C10")
Parse cell
Next
End Sub
Sub Parse(cell As Range)
Dim text As String
text = cell.Value
If text Like "######-???" Then
cell.Offset(, 1) = DateValue(Format$(Left(text, 6), "@@/@@/@@"))
cell.Offset(, 2) = Mid(text, 8)
End If
End Sub