Splitting rows in a table based on date fields.

[Tom123456]

Hey,

I have a list of bookings that have a start & end date and a amount.

I need to split the table so that each month has it's own line and % amount

For example before it would look like this.

[TABLE="class: grid, width: 500, align: left"]
<tbody>[TR]
[TD]Booking[/TD]
[TD]Start Date[/TD]
[TD]End Date[/TD]
[/TR]
[TR]
[TD]Booking 1[/TD]
[TD]01/08/2017[/TD]
[TD]30/11/2017[/TD]
[/TR]
[TR]
[TD]Booking 1[/TD]
[TD]01/10/2017[/TD]
[TD]30/11/2017[/TD]
[/TR]
[TR]
[TD]Booking 2[/TD]
[TD]11/08/2017[/TD]
[TD]30/09/2017[/TD]
[/TR]
[TR]
[TD]Booking 2[/TD]
[TD]11/08/2017[/TD]
[TD]30/09/2017[/TD]
[/TR]
[TR]
[TD]Booking 3[/TD]
[TD]07/08/2017[/TD]
[TD]31/08/2017[/TD]
[/TR]
</tbody>[/TABLE]










but i need to work out how to split it to become like so

[TABLE="class: grid, width: 500, align: left"]
<tbody>[TR]
[TD]Booking[/TD]
[TD]Start Date[/TD]
[TD]End Date[/TD]
[/TR]
[TR]
[TD]Booking 1[/TD]
[TD]01/08/2017[/TD]
[TD]31/08/2017[/TD]
[/TR]
[TR]
[TD]Booking 1[/TD]
[TD]01/09/2017[/TD]
[TD]30/09/2017[/TD]
[/TR]
[TR]
[TD]Booking 2[/TD]
[TD]11/08/2017[/TD]
[TD]31/08/2017[/TD]
[/TR]
[TR]
[TD]Booking 2[/TD]
[TD]01/09/2017[/TD]
[TD]30/09/2017[/TD]
[/TR]
[TR]
[TD]Booking 2[/TD]
[TD]11/08/2017[/TD]
[TD]31/08/2017[/TD]
[/TR]
[TR]
[TD]Booking 2[/TD]
[TD]01/09/2017[/TD]
[TD]30/09/2017[/TD]
[/TR]
[TR]
[TD]Booking 3[/TD]
[TD]07/08/2017[/TD]
[TD]31/08/2017[/TD]
[/TR]
</tbody>[/TABLE]













[TABLE="width: 416"]
<tbody>[TR]
[/TR]
[TR]
[/TR]
[TR]
[TD]I've added columns that calculates the number of days/month in each row and the amount per day but don't know where to start with using this information to split like this- if anyone can point me in the right direction it would be a great help!

Cheers,
Tom[/TD]
[/TR]
[TR]
[/TR]
[TR]
[/TR]
[TR]
[/TR]
[TR]
[/TR]
</tbody>[/TABLE]

 

[Joe4]

OK, here is the code that I came up with. I am sure it will need a few minor tweaks. At the bottom, I will let you know the most likely things you may need to tweak.

Private Sub cmdSplitData_Click()
    Call SplitData
End Sub


Private Sub SplitData()

    Dim db As DAO.Database
    Dim rst As DAO.Recordset

    Dim ref As String
    Dim lineId As Long
    Dim sales As String
    Dim customer As String
    Dim startDt As Date
    Dim endDt As Date
    Dim priCon As String
    Dim brFam As String
    Dim prdPlat As String
    Dim prdType As String
    Dim prdName As String
    Dim units As String
    Dim amount As Currency
    Dim conMonth As String
    Dim custConDt As Date
    Dim amtCur As String
    Dim navID As String
    
    Dim wStartDt As Date
    Dim wEndDt As Date
    Dim nStartDt As Date
    Dim nEndDt As Date
    Dim nAmount As Currency
    Dim lastOne As Boolean
    Dim totDays As Long
    Dim monDays As Long
    Dim monAmt As Currency
    Dim runAmt As Currency
    
    Dim strSQL As String
    
'   Open up query in recordset
    Set db = CurrentDb
    Set rst = db.OpenRecordset("qrySourceTable", dbOpenDynaset)    'enter your query name
    
'   Loop through recordset
    rst.MoveFirst
    Do While Not rst.EOF
'       Capture record values
        ref = rst!Reference
        lineId = rst![Line ID]
        sales = rst![Sales Person]
        customer = rst!customer
        startDt = rst![Start Date]
        endDt = rst![End Date]
        priCon = rst![Primary Contact]
        brFam = rst![Brand Family]
        prdPlat = rst![Product Platform]
        prdType = rst![Product Type]
        prdName = rst![Product Name]
        units = rst![Unit of Measure]
        amount = rst!amount
        conMonth = rst![Contract Month]
        custConDt = rst![Customer Contract Date]
        amtCur = rst![Amount Currency]
        navID = rst![Navision ID]
        
'       Initialize counter
        lastOne = False
        wStartDt = startDt
        wEndDt = EOMDate(startDt)
        runAmt = 0
        
'       Capture total number of days
        totDays = endDt - startDt + 1
        
'       Loop through records
        Do
        
'           Check to see if end date is after end of month, and set dates
            If endDt > wEndDt Then
                nStartDt = wStartDt
                nEndDt = wEndDt
            Else
                nStartDt = wStartDt
                nEndDt = endDt
                lastOne = True
            End If
            
'           Calculate monthly days & monthly amount
            monDays = nEndDt - nStartDt + 1
'           Calculate monthly amount and running amount
            If lastOne Then
                nAmount = amount - runAmt
            Else
                nAmount = Round(amount * monDays / totDays, 2)
                runAmt = runAmt + nAmount
            End If
            
'           Build SQL query to insert new record
            strSQL = "INSERT INTO DestTable ( Reference, [Line ID], [Sales Person], Customer, [Start Date], [End Date], [Primary Contact], [Brand Family], [Product Platform], "
            strSQL = strSQL & "[Product Type], [Product Name], [Unit of Measure], Amount, [Contract Month], [Customer Contract Date], [Amount Currency], [Navision ID]) "
            strSQL = strSQL & "VALUES ('" & ref & "', " & lineId & ", '" & sales & "', '" & customer & "', #" & nStartDt & "#, #" & nEndDt & "#, '"
            strSQL = strSQL & priCon & "', '" & brFam & "', '" & prdPlat & "', '" & prdType & "', '" & prdName & "', '" & units & "', " & nAmount & ", '"
            strSQL = strSQL & conMonth & "', #" & custConDt & "#, '" & amtCur & "', '" & navID & "')"
'           Run SQL
            'MsgBox strSQL
            DoCmd.SetWarnings False
            DoCmd.RunSQL strSQL
            DoCmd.SetWarnings True
          
'           Increment dates for next round
            wStartDt = BOMDate(wEndDt + 1)
            wEndDt = EOMDate(wStartDt)
        
        Loop Until lastOne = True
        
'       Move to next record
        rst.MoveNext
        
    Loop
    
'   Close recordset
    rst.Close
    
    MsgBox "Data split complete!", vbOKOnly


End Sub


Function BOMDate(inputDate) As Date
'   Returns the beginning of month date for any inputted date
    BOMDate = DateSerial(Year(inputDate), Month(inputDate), 1)
End Function


Function EOMDate(inputDate) As Date
'   Returns the end of month date for any inputted date
    EOMDate = DateSerial(Year(inputDate), Month(inputDate) + 1, 0)
End Function

So, I have this currently being called from a Form command button. So the first procedure in the code is a command button call to my main block of code.

I made the following assumptions, some of which may need tweaking:

- The code runs off of a query named "qrySourceTable"
I would recommend running this off of a Query instead of a Table. This allows you to use criteria if you want to exclude certain records, sort your records so that they process in a certain order, and easily make any other changes you need to make.
Even if your Query does nothing more than return all the fields from your Table, I recommend using a Query.
Change the name of "qrySourceTable" in your code to reflect the name of your query.

- The code write to a Table named "SourceTable".
Simply change the reference to "SourceTable" in the code to the name of the Table you want to write the new data to. You will need to have a new Table set up to accept this. This can be set up quickly and easily by copying the structure only of your original table.

- I assumed the following data types for the following fields:
Line ID: numeric
Contract Month: text/string
If those two fields are not those data types, we will need to change the variable declarations that read them in, and add/remove text qualifiers (single quotes) from the appropriate place in the SQL string that is being built.

That's it! I tested it out with a model of your database that I built, and it seems to work and return the correct values.

 

[Tom123456]

Hi Joe,

Thanks for sending this code over! Your assumptions on the fields data types is correct but unfortunately my knowledge of VBA is basic so I'm struggling to implement your solution.

I've created a table named 'Source Table' with the same structure as the data table in my database.

I've created a query named 'qrySourceTable' (which is currently blank)

I've then tried to create a form button and also call the code from a macro but both methods fail - are you able to explain how to set-up the form button to call this code? I have attempted to google how to implement but cant work it out!

Also if the code could run as part of a macro rather then a command button this would be ideal.

Cheers,
Tom

 

[Tom123456]

Just to add I've made my query select everything from my data table.

 

[Joe4]

I've created a table named 'Source Table' with the same structure as the data table in my database.

Sorry, I made a typo here. The name of the blank table we want to create is "DestTable".
And "qrySourceTable" is just the query on your original data Table that returns all the records.
Sorry for the confusion.

To run it from a Macro, do the following:
- from the VB Editor, go to the Project Explorer, right-click, and select Insert -> Module
- put all the VBA code in this new module
- remove the "cmdSplitData_Click" procedure (you don't need this, this is what was calling it from the Form)
- change the header row of the next procedure from this:

Private Sub SplitData()

to this

Public Function SplitData()

- now create a new macro, using the RunCode Action, and enter "SplitData()" into the Function Name argument
(if you cannot see the "RunCode" Action, be sure to click the "Show All Actions" in the ribbon (some are hidden, by default)
- save your Macro and run it

 

[Tom123456]

Thanks Joe

I've followed all these steps but get a compile error 'user-defined type not defined' when i run my macro and it highlights this part 'Dim db As DAO.Database'

Any thoughts?

Tom

 

[Joe4]

In the VB Editor, go to the Tools menu and click on References.
Go down your Reference list, and look for one that looks something like:
Microsoft Office x.0 Access database engine Object Library
and select it.

If that does not work, please let us know the following:
- which version of Access you are using
- list all the References that are selected when you view them (as directed above)

 

[Tom123456]

I'm using Access 2013 and the references i have selected are

Visual Basic for Applications
Microsoft Access 15.0 Object Library
OLE Automation

 

[Joe4]

OK. Did selecting that other one work for you?
I think for your version, the exact name should be:
Microsoft Office 15.0 Access database engine Object Library

 

[Tom123456]

Hi Joe,

I added in this library (Microsoft DAO 3.6) and it resolved the compiler issue. http://www.accessmvp.com/twickerath/articles/adodao.htm

The VBA also does exactly what i wanted it to do! Thank you for all your help with this problem.

One last question - for adding new fields in the source/output i assume the following needs to be done - is this correct?

1) Dim the field (abc as string)
2) Include it in the part to capture record values (abc = rst![abc])
3) Include it in the SQL insert statement (INSERT INTO DestTable ( Reference,[ABC], [Line ID] etc)

Cheers,
Tom

 

[Joe4]

One last question - for adding new fields in the source/output i assume the following needs to be done - is this correct?

1) Dim the field (abc as string)
2) Include it in the part to capture record values (abc = rst![abc])
3) Include it in the SQL insert statement (INSERT INTO DestTable ( Reference,[ABC], [Line ID] etc)

Yes, you got it (and make sure it has been added to your query as well).

Note in the VBA code I have a line commented out that looks like this:

MsgBox strSQL

This is useful in debugging when adding/changing/removing fields. It will show you exactly what the SQL code will look like, so you can check for obvious errors (like missing quotes around text values, etc).

When building SQL strings, one method is to manually create a query that does an example of what you want. Then change the query to SQL View and copy and paste that SQL code to a Word or text document. This is what the SQL code that you are trying build with VBA needs to look like. So you can use that Message Box to return the code it is building, and compare it to the example you copied out, and look for differences.