convert first 6 digits into date

T

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
 
J

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
 
T

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!
 
J

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
 
P

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
 
R

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))
 
R

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).
 
M

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
 
R

Rick Rothstein

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

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
 
M

Mishell

Thank you Rick.

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

Mishell
 
R

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)


Mishell said:
Thank you Rick.

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

Mishell
Click to expand...
 
T

tracktraining

i tried this and it is erroring out at
record_serial = DateSerial(Mid(myserial, 5, 2), _
Left(myserial, 2), Mid(myserial, 3, 2))
Click to expand...

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

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
 
T

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
 
R

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.
 
T

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.
 
T

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
 
P

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
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

VBA - exporting serial letters to single documents 0
Vba Date$ 1
Date formatting 1
Date formatting issue VB 0
Combobox date value matching 0
Today's Date 1
Convert 24/03/2010 date into 03/24/2010 date format 3
ComboBox value matching 0

Top