Celebrate National IT Professionals Day with 3 months of free Premium Membership. Use Code ITDAY17

x
?
Solved

VBA code for Date splitting

Posted on 2012-04-12
18
Medium Priority
?
505 Views
Last Modified: 2012-04-12
Hi,

I am trying to get a piece of code in vba to work. Essentially what it does is split the start and end dates into number of days in each month. It also discounts holidays and weekends. It works mostly fine except when it comes to the last month for each record. The month is recorded wrongly which results in the last month coming up twice.

The data source is attached in the excel file. The destination file contains 4 fields.
Opportunity(text)
Date_code(date)
Monthyear(text)
days_per(number)
Version of Access is 2007

The vba code is given below.

Private Sub PhaseOpps_Click()
DoCmd.SetWarnings (False)

  varInput = "Opps"
  varOutput = "stay_table"
  Call stay_duration(varInput, varOutput)
  DoCmd.SetWarnings (True)
  Set varInput = Nothing
  Set varOutput = Nothing
  
End Sub

Option Compare Database

Public Sub stay_duration(sIn As Variant, sOut As Variant)
On Error GoTo err_report

Dim db As DAO.Database
Dim tblnew As DAO.tabledef
Dim tbl As DAO.Recordset, rst As DAO.Recordset

Dim days_per As Integer, month_hold As Integer
Dim start_date As Date, release_date As Date
Dim year_num As Double, x As Double, y As Double, hold_date As Date
Dim month_name As String, output_table As String, patient_id As String
Dim body As Variant
Dim HolidaysList() As Long
Dim ArrMember As Variant
Dim bWasFound As Boolean

bWasFound = False

HolidayList = Array("27/12/2010", "28/12/2010", "03/01/2011", "22/04/2011", "25/04/2011", "29/04/2011", "02/05/2011", "30/05/2011", "29/08/2011", "26/12/2011", "27/12/2011", "02/01/2012", "06/04/2012", "09/04/2012", "07/05/2012", "04/06/2012", "05/06/2012", "27/08/2012")

Set db = CurrentDb


main:
  output_table = sOut
  DoCmd.DeleteObject acTable, output_table
  Set tblnew = db.CreateTableDef(output_table)
  With tblnew
    .Fields.Append .CreateField("Opportunity", dbText)
    .Fields.Append .CreateField("date_code", dbDate)
    .Fields.Append .CreateField("monthyear", dbText)
    .Fields.Append .CreateField("days_per", dbLong)
  End With
  db.TableDefs.Append tblnew
  body = "Select * from " & sIn
'  body = body & ("select *")
'  body = body & (" ")
'  body = body & ("from Opps;")
  Set rst = db.OpenRecordset(body)
  
  Do Until rst.EOF
  
    start_date = rst.Fields!DateForecastStart
    release_date = rst.Fields!DateOppEnd
    
    x = (release_date - start_date) + 1
    
    month_hold = Month(start_date)
    
    hold_date = start_date
    days_per = 0
    For y = 0 To x - 1
      days_per = 0
      Do While Month(hold_date) = month_hold
            If Weekday(hold_date, vbMonday) < 6 Then
                For Each ArrMember In HolidayList
                    If Format(ArrMember, "dd/mm/yyyy") = Format(hold_date, "dd/mm/yyyy") Then
                        bWasFound = True
                        hold_date = hold_date + 1
                            Exit For
                        Else
                            bWasFound = False
                    End If
                Next ArrMember
                    If bWasFound = False Then
                        days_per = days_per + 1
                        hold_date = hold_date + 1
                    End If
              Else
                    hold_date = hold_date + 1
              End If
            y = y + 1
        
        Select Case y
          Case Is > x - 1
            hold_date = DateSerial(Year(hold_date), Month(hold_date) + 1, 1)
            Exit Do
          
        End Select
        
   
      Loop

      y = y - 1
      Set tbl = db.OpenRecordset(output_table, dbOpenDynaset)
      datecode = DateSerial(Year(hold_date), Month(hold_date) - 1, 1)
      With tbl
        .AddNew
        .Fields(0) = rst.Fields!Opportunity
        .Fields(1) = datecode
        .Fields(2) = Format((datecode), "yyyy") & " " & Format((datecode), "mm")
        .Fields(3) = days_per
        .Update
      End With
      month_hold = Month(hold_date)
    Next y

    rst.MoveNext
  Loop
  GoTo exit_sub

err_report:
  Select Case Err.Number
    Case 7874
      Resume Next
    Case Else
      MsgBox Err.Number & vbCrLf & Err.Description
      GoTo exit_sub
  End Select
    
exit_sub:
  End Sub

Open in new window

0
Comment
Question by:trentbridge
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 9
  • 6
  • 3
18 Comments
 
LVL 51

Expert Comment

by:Gustav Brock
ID: 37837201
Your holidays list is not dates. Change to:

Dim HolidaysList() As Long
HolidayList = Array(#12/27/2010#, #12/28/2010#, .. etc.

Also:

 If DateDiff("d", ArrMember, hold_date) = 0 Then

/gustav
0
 
LVL 48

Expert Comment

by:Dale Fye
ID: 37837221
What does the actual data look like (no file attached).  What are the range of dates between the start and end dates, they obviously span multiple months, but are the on the order of 90 days, a year, or longer?

What do you want to t output to look like?

I generally do  this via a query, but that requires that your holiday dates be in a table, not an array (which is actually better because then you don't have to change your code every year.  If you provide some sample input and output, I'll see if I can resurrect the query I use for that and post it back
0
 

Author Comment

by:trentbridge
ID: 37837250
Sorry forgot to attach sample data. Would prefer if the procedure is in vba. but open to other better solutions
Opps.xlsx
stay-table.xlsx
0
What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

 

Author Comment

by:trentbridge
ID: 37837277
@gustav After changing the code to what you suggested, it gives me type mismatch
0
 
LVL 51

Expert Comment

by:Gustav Brock
ID: 37837328
I guess so. Not knowing whery you encounter the mismatch, you will have to walk through your code and adjust.

/gustav
0
 

Author Comment

by:trentbridge
ID: 37837343
when I took off the # from the date array. it works
0
 

Author Comment

by:trentbridge
ID: 37837375
But my main issue remains unresolved.
See here

Opportunity      date_code      monthyear      days_per
7474232      01/01/2012      2012 01            12
7474232      01/02/2012      2012 02            21
7474232      01/03/2012      2012 03            22
7474232      01/04/2012      2012 04            19
7474232      01/05/2012      2012 05            22
7474232      01/06/2012      2012 06            19
7474232      01/07/2012      2012 07            22
7474232      01/08/2012      2012 08            22
7474232      01/09/2012      2012 09            20
7474232      01/10/2012      2012 10            23
7474232      01/11/2012      2012 11            22
7474232      01/01/2013      2013 01            21

Instead of 2013 01 for the last record. it shows 2013 01. It skips one month
0
 

Author Comment

by:trentbridge
ID: 37837390
I have a feeling that the problem area is this part

     Select Case y
          Case Is > x - 1
            hold_date = DateSerial(Year(hold_date), Month(hold_date) + 1, 1)
            Exit Do
          
        End Select

Open in new window

0
 
LVL 51

Expert Comment

by:Gustav Brock
ID: 37837432
> when I took off the # from the date array. it works

No. The error just vanished, I guess.

> But my main issue remains unresolved.

Yes. You have to be very strict handling dates as dates and not as strings.

My I suggest you reveal where the error occur?

/gustav
0
 
LVL 48

Accepted Solution

by:
Dale Fye earned 2000 total points
ID: 37837448
My SQL solution to this is shown in the attached database.

The final query is shown as: qry_Date_Count_Between_two_dates_by_month_wo_Holiday_and_Weekend.

The way I came up with this is sequentially:
1.  qry_Dates_Between_Two_Dates
2.  qry_Dates_Between_two_Dates_w_Holiday_and_Weekend
3.  qry_Dates_Between_two_Dates_wo_Holiday_and_Weekend

and then the final query.  You only really need query #1 and the final query to implement this in your database.  All you need to do is modify this to make it in Append query and append the values to your destination table.  Hope this helps.
DaysPerMonth.mdb
0
 
LVL 51

Expert Comment

by:Gustav Brock
ID: 37837485
Oops, of course you should use:

Dim HolidaysList() As Date

But, as you use Array(), you must use a Variant:

Dim HolidaysList  As Variant
HollidayList = Array(# ...#, ...)

/gustav
0
 

Author Comment

by:trentbridge
ID: 37837621
@gustav I have run this procedure without the holiday list and still the issue I have is as I mentioned earlier. Personally I have checked by stepping throught the code that the array works without putting #.

My main issue is the months not being assigned properly.
0
 

Author Comment

by:trentbridge
ID: 37837639
@fyed Your solution works brilliantly but because it's query based I will have to re work most of my script. I will wait till tomorrow, if any one comes up with a vba solution. If nothing comes along, I guess, I will have to roll up my sleeves and start changing everything.
0
 
LVL 51

Expert Comment

by:Gustav Brock
ID: 37837752
> .. the array works without putting #.

That may be so but it is not how to do it.
Also, your looping seems a bit convoluted to me.

/gustav
0
 

Author Comment

by:trentbridge
ID: 37837775
@gustav

> ..Also, your looping seems a bit convoluted to me.

Well that's exactly the reason why I am here. I am no great coder. So would be grateful if some one points me in the right direction.
0
 
LVL 51

Expert Comment

by:Gustav Brock
ID: 37837887
For each month, I would first count to total days excluding weekends to get the max. count of workdays for the month.
Then count the holidays picking those for the current month which do not fall in weekends.
Finally, subtract the holidays' count from the workdays.

/gustav
0
 

Author Closing Comment

by:trentbridge
ID: 37838365
Thanks very much for your quick and timely response
0
 
LVL 48

Expert Comment

by:Dale Fye
ID: 37838443
Glad to help.

I had used that database sample a while back to answer a similar question, just had to add in your holidays table. and modify the queries accordingly.
0

Featured Post

U.S. Department of Agriculture and Acronis Access

With the new era of mobile computing, smartphones and tablets, wireless communications and cloud services, the USDA sought to take advantage of a mobilized workforce and the blurring lines between personal and corporate computing resources.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This article describes two methods for creating a combo box that can be used to add new items to the row source -- one for simple lookup tables, and one for a more complex row source where the new item needs data for several fields.
Microsoft Access is a place to store data within tables and represent this stored data using multiple database objects such as in form of macros, forms, reports, etc. After a MS Access database is created there is need to improve the performance and…
Using Microsoft Access, learn some simple rules for how to construct tables in a relational database. Split up all multi-value fields into single values: Split up fields that belong to other things into separate tables: Make sure that all record…
What’s inside an Access Desktop Database. Will look at the basic interface, Navigation Pane (Database Container), Tables, Queries, Forms, Report, Macro’s, and VBA code.

730 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question