Date manipulation within text entries

D

David

Using XL2K:
A2 contains text 'From: Feb 16th'
C2 contains text 'To: Feb 28th 2005'

For alignment purposes I don't want to split to separate cells, but would
like to programatically increase the dates to next bi-monthly period AND
use proper ordinals 'st' or 'th' in the result.

Am I asking too much?
 
B

Bob Phillips

Would you care to elaborate as to what bi-monthly means in this context, as
your example data covers 13 days?

And is this for one cell or many?

--

HTH

RP
(remove nothere from the email address if mailing direct)
 
D

David

Bob Phillips wrote
Would you care to elaborate as to what bi-monthly means in this
context, as your example data covers 13 days?

And is this for one cell or many?

Ok, those are typed entries as they exist now and the last day of Feb is
the 28th. And both entries are single cell.

I want the results of any code (I want assign the code to a button) to
handle two alternating periods:
1) 1st to 15th
2) 16th to end of the month, preferably with need for Analysis ToolPak
 
D

David

PS,
I've been playing with adaptations of a Function() I found after a Google
search for "Date Ordinals":

Function OrdDate1(arg)
dd = Day(arg)
mmm = Format(arg, "mmm")
Select Case Day(arg)
Case 1, 21, 31
OrdDate1 = "From: " & mmm & " " & dd & "st"
Case 2, 22
OrdDate1 = "From: " & mmm & " " & dd & "nd"
Case 3, 23
OrdDate1 = "From: " & mmm & " " & dd & "rd"
Case 4 To 20, 24 To 30
OrdDate1 = "From: " & mmm & " " & dd & "th"
End Select
End Function
Function OrdDate2(arg)
dd = Day(arg)
mmm = Format(arg, "mmm")
yyyy = Year(arg)
Select Case Day(arg)
Case 1, 21, 31
OrdDate2 = "To: " & mmm & " " & dd & "st " & yyyy
Case 2, 22
OrdDate2 = "To: " & mmm & " " & dd & "nd " & yyyy
Case 3, 23
OrdDate2 = "To: " & mmm & " " & dd & "rd " & yyyy
Case 4 To 20, 24 To 30
OrdDate2 = "To: " & mmm & " " & dd & "th " & yyyy
End Select
End Function

Testing has been limited to making A2 '=orddate1(Today())'
and C2 '=orddate2(Today()+14)
(obviously not the desired date ranges)
 
R

Ron Rosenfeld

Using XL2K:
A2 contains text 'From: Feb 16th'
C2 contains text 'To: Feb 28th 2005'

For alignment purposes I don't want to split to separate cells, but would
like to programatically increase the dates to next bi-monthly period AND
use proper ordinals 'st' or 'th' in the result.

Am I asking too much?

I'm not sure exactly what you want. But with a date (real excel date, not a
text string) in A2, the following Sub will increase the date by two weeks; put
the ending date in C2; and format the date as you describe.

You may have to change some of the details to suit your needs.

========================================
Sub BiWeeklyDt()
Dim rg1 As Range, rg2 As Range
Dim dy As Long
Dim Suffix As String
Dim Fmt As String

Const Quote As String = """"

Set rg1 = Range("A2")
Set rg2 = Range("C2")

If IsDate(rg1.Value) Then
rg1.Value = rg1.Value + 14
rg2.Value = rg1.Value + 13
dy = Day(rg1.Value)
Suffix = Quote & OrdinalSuffix(dy) & Quote
Fmt = """From: """ & "mmm d" & Suffix
rg1.NumberFormat = Fmt

dy = Day(rg2.Value)
Suffix = Quote & OrdinalSuffix(dy) & Quote
Fmt = """To: """ & "mmm d" & Suffix & " yyyy"
rg2.NumberFormat = Fmt

End If

End Sub

Function OrdinalSuffix(Num) As String
Dim Suffix As String

If Not IsNumeric(Num) Then Exit Function
If Num <> Int(Num) Then Exit Function

Select Case Num Mod 10
Case Is = 1
Suffix = "st"
Case Is = 2
Suffix = "nd"
Case Is = 3
Suffix = "rd"
Case Else
Suffix = "th"
End Select

Select Case Num Mod 100
Case 11 To 19
Suffix = "th"
End Select

OrdinalSuffix = Suffix
End Function
===============================


--ron
 
B

Bob Phillips

Try these

Function OrdDate1(arg)
dd = 1 - 15 * (Day(arg) > 15)
mmm = Format(arg, "mmm")
OrdDate1 = "From: " & mmm & " " & dd
Select Case dd
Case 1, 21, 31: OrdDate1 = OrdDate1 & "st"
Case 2, 22: OrdDate1 = OrdDate1 & "nd"
Case 3, 23: OrdDate1 = OrdDate1 & "rd"
Case Else: OrdDate1 = OrdDate1 & "th"
End Select
End Function

Function OrdDate2(arg)
If Day(arg) > 15 Then
dd = Day(DateSerial(Year(arg), Month(arg) + 1, 0))
Else
dd = 15
End If
mmm = Format(arg, "mmm")
yyyy = Year(arg)
OrdDate2 = "To: " & mmm & " " & dd
Select Case dd
Case 1, 21, 31: OrdDate2 = OrdDate2 & "st " & yyyy
Case 2, 22: OrdDate2 = OrdDate2 & "nd " & yyyy
Case 3, 23: OrdDate2 = OrdDate2 & "rd " & yyyy
Case Else: OrdDate2 = OrdDate2 & "th " & yyyy
End Select
End Function





--

HTH

RP
(remove nothere from the email address if mailing direct)
 
R

Ron Rosenfeld

I'm not sure exactly what you want. But with a date (real excel date, not a
text string) in A2, the following Sub will increase the date by two weeks; put
the ending date in C2; and format the date as you describe.

You may have to change some of the details to suit your needs.

========================================
Sub BiWeeklyDt()
Dim rg1 As Range, rg2 As Range
Dim dy As Long
Dim Suffix As String
Dim Fmt As String

Const Quote As String = """"

Set rg1 = Range("A2")
Set rg2 = Range("C2")

If IsDate(rg1.Value) Then
rg1.Value = rg1.Value + 14
rg2.Value = rg1.Value + 13
dy = Day(rg1.Value)
Suffix = Quote & OrdinalSuffix(dy) & Quote
Fmt = """From: """ & "mmm d" & Suffix
rg1.NumberFormat = Fmt

dy = Day(rg2.Value)
Suffix = Quote & OrdinalSuffix(dy) & Quote
Fmt = """To: """ & "mmm d" & Suffix & " yyyy"
rg2.NumberFormat = Fmt

End If

End Sub

Function OrdinalSuffix(Num) As String
Dim Suffix As String

If Not IsNumeric(Num) Then Exit Function
If Num <> Int(Num) Then Exit Function

Select Case Num Mod 10
Case Is = 1
Suffix = "st"
Case Is = 2
Suffix = "nd"
Case Is = 3
Suffix = "rd"
Case Else
Suffix = "th"
End Select

Select Case Num Mod 100
Case 11 To 19
Suffix = "th"
End Select

OrdinalSuffix = Suffix
End Function
===============================


--ron

Or Perhaps:

Note that this format has "real" Excel dates in A2 and C2 that you can use in
other calculations:

===============================

Sub BiWeeklyDt()
Dim rg1 As Range, rg2 As Range
Dim dy As Long
Dim Suffix As String
Dim Fmt As String

Const Quote As String = """"
Const P1 As String = """From: """
Const P2 As String = """To: """
Const DtFmt1 As String = "mmm d"
Const DtFmt2 As String = " yyyy"

Set rg1 = Range("A2")
Set rg2 = Range("C2")

If Not (IsDate(rg1.Value)) Then rg1.Value = Date - 14

If IsDate(rg1.Value) Then
rg1.Value = rg1.Value + 14
rg2.Value = rg1.Value + 13
dy = Day(rg1.Value)
Suffix = Quote & OrdinalSuffix(dy) & Quote
Fmt = P1 & DtFmt1 & Suffix
rg1.NumberFormat = Fmt

dy = Day(rg2.Value)
Suffix = Quote & OrdinalSuffix(dy) & Quote
Fmt = P2 & DtFmt1 & Suffix & DtFmt2
rg2.NumberFormat = Fmt

End If

End Sub

Function OrdinalSuffix(Num) As String
Dim Suffix As String

If Not IsNumeric(Num) Then Exit Function
If Num <> Int(Num) Then Exit Function

Select Case Num Mod 10
Case Is = 1
Suffix = "st"
Case Is = 2
Suffix = "nd"
Case Is = 3
Suffix = "rd"
Case Else
Suffix = "th"
End Select

Select Case Num Mod 100
Case 11 To 19
Suffix = "th"
End Select

OrdinalSuffix = Suffix
End Function
=================================
--ron
 
D

David

Bob Phillips wrote
Try these

Function OrdDate1(arg)
dd = 1 - 15 * (Day(arg) > 15)
mmm = Format(arg, "mmm")
OrdDate1 = "From: " & mmm & " " & dd
Select Case dd
Case 1, 21, 31: OrdDate1 = OrdDate1 & "st"
Case 2, 22: OrdDate1 = OrdDate1 & "nd"
Case 3, 23: OrdDate1 = OrdDate1 & "rd"
Case Else: OrdDate1 = OrdDate1 & "th"
End Select
End Function

Function OrdDate2(arg)
If Day(arg) > 15 Then
dd = Day(DateSerial(Year(arg), Month(arg) + 1, 0))
Else
dd = 15
End If
mmm = Format(arg, "mmm")
yyyy = Year(arg)
OrdDate2 = "To: " & mmm & " " & dd
Select Case dd
Case 1, 21, 31: OrdDate2 = OrdDate2 & "st " & yyyy
Case 2, 22: OrdDate2 = OrdDate2 & "nd " & yyyy
Case 3, 23: OrdDate2 = OrdDate2 & "rd " & yyyy
Case Else: OrdDate2 = OrdDate2 & "th " & yyyy
End Select
End Function

Sorry, just got home from work.

Ok, these look the most promising as Ron's offering appears to be for
biweekly calcs and I need bimonthly. Now, how to implement with a Sub
that can be assigned to a button on my sheet. Reason I want this is
because this sheet is not always processed in a timely fashion and the
actual date it IS may be a few days after the 15th or a few days after
the end of the month, so I need "on demand" processing.

I can put actual dates for the 1st and 16th formatted as "d" in B5 and
B6, so for the 1st part of the month:
A2 =OrdDate1(B5)
C2 =OrdDate2(B5)
and for the 2nd part of the month:
A2 =OrdDate1(B6)
C2 =OrdDate2(B6)

The sub (in addition to other stuff) should, with each button click:
1) Alternately advance dates in B5 & B6
2) Alternately change A2/C2 cell references between (B5) & (B6)

To clarify -- say I have:
3/1/2005 in B5
3/16/2005 in B6

1st click changes B5 to 4/1/2005 and A2/C2 cell references to (B6)
2nd click changes B6 to 4/16/2005 and A2/C2 cell references to (B5)
3rd click changes B5 to 5/1/2005 and A2/C2 cell references to (B6)
4th click changes B6 to 5/16/2005 and A2/C2 cell references to (B5)
....and so on.

Or maybe totally change the strategy, but I *must* keep A2 & C2's format.
 
B

Bob Phillips

David,

A suggestion, but this is how I would do it.

Assuming that you have a start position, that is a start and end date in
worksheet cells, I would implement two buttons, one that incremented to the
next period, one that would decrement to the previous period. That way, you
can control the output, even if you don't get to your computer for the whole
of a period.

What do you think? And would you want the buttons on a toolbar, or on the
worksheet?

--

HTH

RP
(remove nothere from the email address if mailing direct)
 
R

Ron Rosenfeld

Ron's offering appears to be for
biweekly calcs and I need bimonthly.

I misread your post. But it would be trivial to have my routine calculate
bimonthly instead of biweekly.

The following assumes that the first bimonthly period runs from 1 to 15; and
the second from 16 to the end of the month:

==========================
Sub BiMonthlyDt()
Dim rg1 As Range, rg2 As Range
Dim dy As Long
Dim Suffix As String
Dim Fmt As String

Const Quote As String = """"
Const P1 As String = """From: """
Const P2 As String = """To: """
Const DtFmt1 As String = "mmm d"
Const DtFmt2 As String = " yyyy"

Set rg1 = Range("A2")
Set rg2 = Range("C2")

If Not (IsDate(rg1.Value)) Then rg1.Value = DateSerial(Year(Date), Month(Date),
0)
dy = Day(rg1.Value)
If IsDate(rg1.Value) Then
Select Case dy
Case Is = 1
rg1.Value = rg1.Value + 15
rg2.Value = DateSerial(Year(rg1.Value), Month(rg1.Value) + 1, 0)
Case Else
rg1.Value = DateSerial(Year(rg1.Value), Month(rg1.Value) + 1, 1)
rg2.Value = rg1.Value + 14
End Select

dy = Day(rg1.Value)
Suffix = Quote & OrdinalSuffix(dy) & Quote
Fmt = P1 & DtFmt1 & Suffix
rg1.NumberFormat = Fmt

dy = Day(rg2.Value)
Suffix = Quote & OrdinalSuffix(dy) & Quote
Fmt = P2 & DtFmt1 & Suffix & DtFmt2
rg2.NumberFormat = Fmt

End If

End Sub

Function OrdinalSuffix(Num) As String
Dim Suffix As String

If Not IsNumeric(Num) Then Exit Function
If Num <> Int(Num) Then Exit Function

Select Case Num Mod 10
Case Is = 1
Suffix = "st"
Case Is = 2
Suffix = "nd"
Case Is = 3
Suffix = "rd"
Case Else
Suffix = "th"
End Select

Select Case Num Mod 100
Case 11 To 19
Suffix = "th"
End Select

OrdinalSuffix = Suffix
End Function
==============================
--ron
 
D

David

Bob Phillips wrote
Subject: Re: Date manipulation within text entries
From: "Bob Phillips" <[email protected]>
Newsgroups: microsoft.public.excel.programming

David,

A suggestion, but this is how I would do it.

Assuming that you have a start position, that is a start and end date
in worksheet cells, I would implement two buttons, one that
incremented to the next period, one that would decrement to the
previous period. That way, you can control the output, even if you
don't get to your computer for the whole of a period.

What do you think? And would you want the buttons on a toolbar, or on
the worksheet?

Well, I was hoping to avoid populating more than B5 and B6 with dates,
because current layout has text numbers representing the dates a cell apart
in the row, and that complicates things. This sheet was sent to us by an
employer and I don't feel comfortable in altering its layout. I would not
be adverse to having two buttons,though, one for first period (1-15) and
another for second period (16-??). Would prefer one, but hey...
Would also prefer button(s) on sheet itself.
 
D

David

Ron Rosenfeld wrote
Sub BiMonthlyDt()
Dim rg1 As Range, rg2 As Range
Dim dy As Long
Dim Suffix As String
Dim Fmt As String

Const Quote As String = """"
Const P1 As String = """From: """
Const P2 As String = """To: """
Const DtFmt1 As String = "mmm d"
Const DtFmt2 As String = " yyyy"

Set rg1 = Range("A2")
Set rg2 = Range("C2")

If Not (IsDate(rg1.Value)) Then rg1.Value = DateSerial(Year(Date),
Month(Date), 0)
dy = Day(rg1.Value)
If IsDate(rg1.Value) Then
Select Case dy
Case Is = 1
rg1.Value = rg1.Value + 15
rg2.Value = DateSerial(Year(rg1.Value), Month(rg1.Value) +
1, 0)
Case Else
rg1.Value = DateSerial(Year(rg1.Value), Month(rg1.Value) +
1, 1) rg2.Value = rg1.Value + 14
End Select

dy = Day(rg1.Value)
Suffix = Quote & OrdinalSuffix(dy) & Quote
Fmt = P1 & DtFmt1 & Suffix
rg1.NumberFormat = Fmt

dy = Day(rg2.Value)
Suffix = Quote & OrdinalSuffix(dy) & Quote
Fmt = P2 & DtFmt1 & Suffix & DtFmt2
rg2.NumberFormat = Fmt

End If

End Sub

Function OrdinalSuffix(Num) As String
Dim Suffix As String

If Not IsNumeric(Num) Then Exit Function
If Num <> Int(Num) Then Exit Function

Select Case Num Mod 10
Case Is = 1
Suffix = "st"
Case Is = 2
Suffix = "nd"
Case Is = 3
Suffix = "rd"
Case Else
Suffix = "th"
End Select

Select Case Num Mod 100
Case 11 To 19
Suffix = "th"
End Select

OrdinalSuffix = Suffix
End Function

Works perfectly!!! And much less convoluted than what I proposed to Bob,
although I still think it could be accomplished and with less code. I do
like your single function approach over the dual functions, though.

Many thanks.
 
R

Ron Rosenfeld

Works perfectly!!! And much less convoluted than what I proposed to Bob,
although I still think it could be accomplished and with less code. I do
like your single function approach over the dual functions, though.

Many thanks.

You're welcome. Glad to help.

By the way, it can be made a little shorter even with the same algorithm by
deleting some stuff that is extraneous to the current routine.

But sometimes it's best to make things a little more lengthy, so as to lead to
easier maintenance.

But here's a bit shorter variation:

==========================
Sub BiMonthlyDt()
Dim rg1 As Range, rg2 As Range
Dim dy As Long
Dim Suffix As String
Dim Fmt As String

Const Quote As String = """"
Const P1 As String = """From: """
Const P2 As String = """To: """
Const DtFmt1 As String = "mmm d"
Const DtFmt2 As String = " yyyy"

Set rg1 = Range("A2")
Set rg2 = Range("C2")

If Not (IsDate(rg1.Value)) Then _
rg1.Value = DateSerial(Year(Date), Month(Date), 0)

dy = Day(rg1.Value)

Select Case dy
Case Is = 1
rg1.Value = rg1.Value + 15
rg2.Value = DateSerial(Year(rg1.Value), Month(rg1.Value) + 1, 0)
Case Else
rg1.Value = DateSerial(Year(rg1.Value), Month(rg1.Value) + 1, 1)
rg2.Value = rg1.Value + 14
End Select

dy = Day(rg1.Value)
Suffix = Quote & OrdinalSuffix(dy) & Quote
Fmt = P1 & DtFmt1 & Suffix
rg1.NumberFormat = Fmt

dy = Day(rg2.Value)
Suffix = Quote & OrdinalSuffix(dy) & Quote
Fmt = P2 & DtFmt1 & Suffix & DtFmt2
rg2.NumberFormat = Fmt



End Sub

Function OrdinalSuffix(Num) As String
Dim Suffix As String

If Not IsNumeric(Num) Then Exit Function
If Num <> Int(Num) Then Exit Function

Select Case Num Mod 10
Case Is = 1
Suffix = "st"
Case Is = 2
Suffix = "nd"
Case Is = 3
Suffix = "rd"
Case Else
Suffix = "th"
End Select

OrdinalSuffix = Suffix
End Function

============================

Best,

--ron
 
D

David

Ron Rosenfeld wrote
By the way, it can be made a little shorter even with the same
algorithm by deleting some stuff that is extraneous to the current
routine.

But sometimes it's best to make things a little more lengthy, so as to
lead to easier maintenance.

But here's a bit shorter variation:

Gotcha, doesn't seem to need:
Select Case Num Mod 100
Case 11 To 19
Suffix = "th"
End Select

BTW, looking at that, I'm just curious

Case Is = 1
Suffix = "st"
Case Is = 2
Suffix = "nd"
Case Is = 3
Suffix = "rd"
OR
Case 1
Suffix = "st"
Case 2
Suffix = "nd"
Case 3
Suffix = "rd"

Both work for me, and I'm used to seeing the latter syntax. Can you
enlighten me as to the difference -- if any?
 
B

Bob Phillips

David said:
BTW, looking at that, I'm just curious

Case Is = 1
Suffix = "st"
Case Is = 2
Suffix = "nd"
Case Is = 3
Suffix = "rd"
OR
Case 1
Suffix = "st"
Case 2
Suffix = "nd"
Case 3
Suffix = "rd"

Both work for me, and I'm used to seeing the latter syntax. Can you
enlighten me as to the difference -- if any?

As stated in help

Use the Is keyword with comparison operators (except Is and Like) to specify
a range of values. If not supplied, the Is keyword is automatically
inserted.

So in this instance


Select Case a
Case Is = "abc": Debug.Print "yes"
Case Is = "xyz": Debug.Print "no"
End Select

if you omit the Is, VBA will insert it. But

Select Case a
Case "abc": Debug.Print "yes"
Case "xyz": Debug.Print "no"
End Select

works equally as well, which is what you have found.
 
R

Ron Rosenfeld

Function OrdinalSuffix(Num) As String
Dim Suffix As String

If Not IsNumeric(Num) Then Exit Function
If Num <> Int(Num) Then Exit Function

Select Case Num Mod 10
Case Is = 1
Suffix = "st"
Case Is = 2
Suffix = "nd"
Case Is = 3
Suffix = "rd"
Case Else
Suffix = "th"
End Select

Select Case Num Mod 100
Case 11 To 19
Suffix = "th"
End Select

OrdinalSuffix = Suffix
End Function

And, a little shorter by eliminating more stuff from the OrdinalSuffix routine:

==================
Sub BiMonthlyDt()
Dim rg1 As Range, rg2 As Range
Dim dy As Long
Dim Suffix As String
Dim Fmt As String

Const Quote As String = """"
Const P1 As String = """From: """
Const P2 As String = """To: """
Const DtFmt1 As String = "mmm d"
Const DtFmt2 As String = " yyyy"

Set rg1 = Range("A2")
Set rg2 = Range("C2")

If Not (IsDate(rg1.Value)) Then _
rg1.Value = DateSerial(Year(Date), Month(Date), 0)

dy = Day(rg1.Value)

Select Case dy
Case Is = 1
rg1.Value = rg1.Value + 15
rg2.Value = DateSerial(Year(rg1.Value), Month(rg1.Value) + 1, 0)
Case Else
rg1.Value = DateSerial(Year(rg1.Value), Month(rg1.Value) + 1, 1)
rg2.Value = rg1.Value + 14
End Select

dy = Day(rg1.Value)
Suffix = Quote & OrdinalSuffix(dy) & Quote
Fmt = P1 & DtFmt1 & Suffix
rg1.NumberFormat = Fmt

dy = Day(rg2.Value)
Suffix = Quote & OrdinalSuffix(dy) & Quote
Fmt = P2 & DtFmt1 & Suffix & DtFmt2
rg2.NumberFormat = Fmt

End Sub

Private Function OrdinalSuffix(Num) As String
Dim Suffix As String

Select Case Num
Case Is = 1, 31
Suffix = "st"
Case Else
Suffix = "th"
End Select

OrdinalSuffix = Suffix
End Function
==========================


--ron
 
R

Ron Rosenfeld

Gotcha, doesn't seem to need:
Select Case Num Mod 100
Case 11 To 19
Suffix = "th"
End Select

And you also don't need to check, in OrdinalSuffix, for the input being
numeric. Since it is forced that way.

But with all those changes, I would make the function Private.

See my posting of a few minutes ago, done before I read yours.

:)


--ron
 
R

Ron Rosenfeld

And you also don't need to check, in OrdinalSuffix, for the input being
numeric. Since it is forced that way.

But with all those changes, I would make the function Private.

See my posting of a few minutes ago, done before I read yours.

:)


--ron

And even shorter, and more focused on exactly what is necessary for this
routine:


=========================
Private Function OrdinalSuffix(Num) As String

Select Case Num
Case Is = 1, 31
OrdinalSuffix = "st"
Case Else
OrdinalSuffix = "th"
End Select

End Function
================================

Since the input can only be:

1, 15, 16, 28, 29, 30, 31 there is no need to check for anything else.


--ron
 
D

David

Bob Phillips wrote
As stated in help

Use the Is keyword with comparison operators (except Is and Like) to
specify a range of values. If not supplied, the Is keyword is
automatically inserted.

So in this instance


Select Case a
Case Is = "abc": Debug.Print "yes"
Case Is = "xyz": Debug.Print "no"
End Select

if you omit the Is, VBA will insert it. But

Select Case a
Case "abc": Debug.Print "yes"
Case "xyz": Debug.Print "no"
End Select

works equally as well, which is what you have found.

Thanks
 
D

David

Ron Rosenfeld wrote
If Not (IsDate(rg1.Value)) Then _
rg1.Value = DateSerial(Year(Date), Month(Date), 0)

I've also found I don't need this, at least after very first trial.
 

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

Top