Question : Weekly price averages for 5000+ items as charts saved as graphic

Dear all,

First post for me here. I am a weekend MS Access user who has a very specific need:

I have a MS Access database with historic price information for 5000+ products in the format:

Product ID, Date/Time, Price
(Text), (Date/Time), ($.$$)

What I would like to do is create a chart for every unique product in the database, that shows price averages, highest as well as lowest prices for the past 52 weeks as well as how many data points contributed to the averages and saves the charts as graphic using the product name as file name. Below some sample data:

%ID% %Date/Time% %Price%
J101-1888A 9/8/2005 20:45 101
J10-1890J 9/6/2005 22:19 10.06
J10-1891F 9/4/2005 20:00 10.7
J10-1892G 9/1/2005 18:15 10.51
J10-1893D 9/6/2005 18:50 1
J10-1893F 9/4/2005 17:26 9.5
J10-1895F 8/31/2005 19:36 7.29
J10-1895J 9/9/2005 20:30 1
J10-1896F 9/6/2005 18:48 1
J10-1897A 9/9/2005 20:30 3.07
J10-1900J 9/1/2005 19:26 3.07
J10-1902G 9/4/2005 20:00 12.05
J10-1903D 9/7/2005 19:06 6.13
J10-1903F 8/30/2005 18:44 6.03
J10-1904A 9/9/2005 20:31 1
J10-1906D 9/2/2005 21:08 1.99
J10-1916J 8/31/2005 21:24 3.53
J102-1892A 8/29/2005 20:54 131.05
J102-1896A 9/9/2005 20:01 14.72
J102-1896A 9/4/2005 11:00 9.5
J102-1898A 8/31/2005 19:20 25.5
J102-1898A 9/5/2005 18:35 16.44
J102-1899A 9/3/2005 12:57 8.62
J102-1899A 8/31/2005 19:03 7.01
J102-1899A 9/3/2005 15:45 13.38
J102-1900A 8/31/2005 19:06 7.5
J102-1900A 9/4/2005 21:24 26.27
J102-1900A 8/29/2005 11:58 12.5
J102-1902A 9/2/2005 12:49 8.6
J102-1902A 9/8/2005 17:53 8.55
J102-1902A 9/2/2005 19:47 6.44
J102-1903A 8/31/2005 14:50 7.09
J102-1904A 8/30/2005 19:51 9.75
J102-1904A 8/29/2005 20:58 5.5
J102-1904A 8/31/2005 19:01 11.6
J102-1904A 9/4/2005 21:15 7.01
J102-1904A 9/1/2005 19:19 7.9
J102-1904A 9/3/2005 16:15 8
J102-1904A 8/30/2005 19:29 5.04
J102-1905A 9/7/2005 8:59 4.39
J102-1905A 9/4/2005 23:01 5
J102-1905A 8/31/2005 19:08 6.55
J102-1907A 9/2/2005 19:47 5.27
J102-1907A 9/9/2005 18:17 9.16
J102-1908A 9/2/2005 19:47 8
J102-1912A 9/4/2005 18:58 11.1
J103-1908A 9/3/2005 15:00 11.05
J103-1908A 8/30/2005 15:31 56.99
J103-1908A 8/29/2005 14:02 5.6
J103-1908A 9/4/2005 10:47 7
J103-1908A 8/31/2005 20:00 3.53
J103-1908A 9/4/2005 17:30 6.05
J103-1909A 9/1/2005 9:21 4.76
J103-1909A 9/2/2005 22:29 7.1
J103-1909A 8/30/2005 14:14 9.09
J103-1909A 8/30/2005 16:55 8.5
J103-1909A 8/29/2005 14:28 2.65
J103-1909A 9/6/2005 23:19 8.51
J103-1909A 9/4/2005 11:39 5.62
J103-1909A 9/4/2005 20:15 4.55
J103-1909A 8/29/2005 10:20 5.55
J103-1909A 9/4/2005 18:15 5.17
J103-1912A 9/2/2005 14:32 4.5
J103-1912A 8/31/2005 19:33 10
J103-1912A 8/29/2005 14:34 3.6
J103-1912A 9/4/2005 18:56 6.5
J103-1912A 9/4/2005 18:55 6
J103-1912A 8/29/2005 20:42 6.01
J103-1912A 9/4/2005 18:30 7.4

Greatly appreciate your input. If you need more points or other compensation (within reason) to get this solved for me we can talk about it.

Stefan

Answer : Weekly price averages for 5000+ items as charts saved as graphic

Ok, well i did quite a bit of work on this off Experts exchange, so here is the synopsis of the solution for any future users.

the data set is by individual sales.

the management view of the data is required by wek with quantity, min, max and average.

i gathered these using a make table query. which is run when the DB is opened ( button click by user, this also opens up the extract form.)

DataTable is the table detailing the main data set.

SELECT DataTable.productID, Count(DataTable.Date) AS CountOfDate, Min(DataTable.price) AS MinOfprice, Max(DataTable.price) AS MaxOfprice, Avg(DataTable.price) AS AvgOfprice
INTO chart_store
FROM DataTable
WHERE (((DataTable.Date)>=DateAdd("ww",-52,Now())))
GROUP BY DataTable.productID;


the extract form will output the required stock chart graph for the selected product in a combo box....if no product is selected it outputs all products.  the form included a textbox for output path and also a check box for show/hide excel during extract.

The outputs for the form will be a master spreadsheet containing the aggregated dataset, the chart generated from it, and the actual core data for that product.

The project was further complicated by user request to have the weeks where no sales occured populated with a 0 value, so that all the last years weeks would appear on the graph.

The onclick for the button on this form does the following:

works out the current week.
finds out if user is running for specific product or all products
if all, it runs the same code but inside a loop...
set up save addresses for the aggreg and full data ( and image path)
calls the sub procedure for exporting to excel

'set the running flag
DoCmd.Hourglass True
aborted = "no"
'work out what the current week number is
DoCmd.SetWarnings False
DoCmd.OpenQuery "1_set_current_yr_week"
DoCmd.SetWarnings True
If IsNull(Me.Combo0.Value) Then
'user has selected to run for all product id's
    VBQuest = MsgBox("You are about to run the chart maker for " & Me.Combo0.ListCount & vbCrLf & _
    " product id's.  Are you sure?", vbYesNo, "Warning")
    If VBQuest = vbYes Then
        For Lcount = 0 To Combo0.ListCount - 1
            If aborted = "no" Then
            'keep running
                'get first product
                Combo0.Value = Combo0.ItemData(Lcount)
                'set up products target file path name
                save_aggreg = get_file & Combo0.Value & ".xls"
                save_full = get_file & "X_" & Combo0.Value & "_detail.xls"
                DoCmd.SetWarnings False
                'output and run graph maker / exporter
                excel_process
                DoCmd.SetWarnings True
            Else
            'aborted = yes, so stop running
                Lcount = Combo0.ListCount - 1
            End If
        Next Lcount
    End If
Else
'user has selected to un for a single productID
DoCmd.SetWarnings False
'set up products target file path name
save_aggreg = get_file & Combo0.Value & ".xls"
save_full = get_file & "X_" & Combo0.Value & "_detail.xls"
'output and run graph maker / exporter
excel_process
DoCmd.SetWarnings False
'
DoCmd.Hourglass False

End If

End Sub


the excel subprocedure encoutnered several errors which needed trapping along the way, it also calls two further subprocedures - get full years data - which uses find unmatched to populate the weekly gaps ( where no sales occured) and getfile - which makes sure there is a "\" at the end of he file save path

Public Sub excel_process()
On Error GoTo err_trap

' make this product_id's Data
GET_full_years_data

'output the current product to excel
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "source_2_export", save_aggreg
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "all_records_for_prod_id", save_full

'declare necessary objects
Dim objExcel, objRange, colCharts, objChart As Object
Dim objsheet As Worksheet
Dim found_arfpi As String
found_arfpi = ""
'create an instance of excel
Set objExcel = CreateObject("Excel.Application")



'make the excel window visible if check is selected on form
objExcel.Visible = Me.Check7.Value
'open the recently created xls file of the data for the product for the last 52 weeks
objExcel.Workbooks.Open Filename:=save_aggreg
'Set objSheet = objExcel.Sheet
For Each objsheet In objExcel.Worksheets
'objExcel.Workbooks.Open Filename:=save_full
'MsgBox objsheet.Name
If objsheet.Name = "all_records_for_prod_id" Then
found_arfpi = "True"
End If

Next objsheet

'Selection.Columns.AutoFit on data sheet'
If found_arfpi <> "true" Then
found_arfpi = ""
objExcel.Workbooks.Open Filename:=save_full
'objExcel.Sheets("all_records_for_prod_id").Activate
'objExcel.ActiveSheet.UsedRange.Select
objExcel.Sheets("all_records_for_prod_id").Select
objExcel.ActiveSheet.UsedRange.Select
objExcel.Selection.Copy
objExcel.Windows(Combo0.Value & ".xls").Activate
objExcel.Sheets.Add
objExcel.ActiveSheet.Paste
objExcel.Application.CutCopyMode = False
objExcel.Sheets("Sheet1").Select
objExcel.Sheets("Sheet1").Name = "all_records_for_prod_id"

'objExcel.Sheets("all_records_for_prod_id").Copy Before:=objExcel.Workbooks("J101-1888A.xls"). _
        Sheets(1)
'objExcel.Sheets("all_records_for_prod_id").Copy Before:=Workbooks(Combo0.Value & ".xls").Sheets(0)
objExcel.Workbooks("X_" & Combo0.Value & "_detail.xls").Close
End If
objExcel.Sheets("all_records_for_prod_id").Activate
objExcel.ActiveSheet.UsedRange.Select
'Selection.Columns.AutoFit
'the bug was the line above, i had pasted the excel macro
'code to widen the columns in the core data to display the date field
'but had forgotten to add the word to reference the excel object:
objExcel.Selection.Columns.AutoFit

'declare and store the range of data for use in the chart
objExcel.Sheets("source_2_export").Activate
Set objRange = objExcel.ActiveSheet.UsedRange
objRange.Select

'add a chart
objExcel.Charts.Add

Set objChart = objExcel.Charts(1)
objChart.Activate
objChart.ChartType = xlStockVHLC

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~#
'# this is where we will add code for your type of chart#
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

With objChart

        .Activate
        .ChartType = xlStockVHLC
        .HasTitle = True
        .ChartTitle.Characters.Text = Combo0.Value
        .Axes(xlCategory, xlPrimary).HasTitle = False
        .Axes(xlValue, xlPrimary).HasTitle = False
        .Axes(xlCategory, xlSecondary).HasTitle = False
        .Axes(xlValue, xlSecondary).HasTitle = False
    End With

objExcel.DisplayAlerts = False


'export the chart as filename.gif
objExcel.Charts(1).Export Replace(save_aggreg, "xls", "jpg", 1, 1), "jpg"

'save the source spreadsheet for that product id
objExcel.ActiveWorkbook.Save

'close the prod id spreadsheet
objExcel.ActiveWorkbook.Close

'trap for errors
err_trap:
Select Case Err.Number
Case 3010 ' the excel file already exists at the specified location
MsgBox "Please select a new folder to write the new data to" & vbCrLf & _
"or empty the current folder.  Processing aborted"
aborted = "yes"
Forms!chart_maker!Text4.SetFocus
GoTo false_start
Case 0
Case 1004
'only one row of data
GoTo false_start
Case Else
MsgBox Err.Number & vbCrLf & Err.Description
objExcel.Visible = True
'no other erors found worth trapping yet
Resume Next
End Select
objExcel.Quit

'free up the object
Set objExcel = Nothing
false_start:

End Sub

Public Function get_file() As String
'get pat to save the files too
If Right(RTrim(Text4.Value), 1) = "\" Then
get_file = Me.Text4.Value
Else
get_file = Me.Text4.Value & "\"
End If
End Function

Public Sub GET_full_years_data()
' procedure to run the queries for the current product to populate non sale weeks
DoCmd.SetWarnings False
'get the data for the current product ID
DoCmd.OpenQuery "2_Make_source2_export"
'SELECT DISTINCTROW Format([date],"yyyy") & "-" & Format([date],"ww") AS Week, Count(DataTable.Date) AS 'DataPoints, Min(DataTable.price) AS [Min], Max(DataTable.price) AS [Max], Avg(DataTable.price) AS Avr INTO source2
'FROM DataTable
'GROUP BY Format([date],"yyyy") & "-" & Format([date],"ww"), DataTable.productID
'HAVING (((DataTable.productID)=[Forms]![Chart_maker]![Combo0].[value]));

'create years worth of missing data
DoCmd.OpenQuery "3_show_all_dates_in_range_as_0"
'SELECT year_week.year_week, year_week.id, 0 AS DataPoints, 0 AS [Min], 0 AS [Max], 0 AS Avr INTO [range_as_zero's]
'FROM get_range_of_dates, year_week
'WHERE (((year_week.id) Between [current] And [prev]))
'ORDER BY year_week.id DESC;

'Add in the 0 value missing data
DoCmd.OpenQuery "4_range_as_zero's Without Matching source2"
'INSERT INTO source2 ( Week, DataPoints, [Min], [Max], Avr )
SELECT [range_as_zero's].year_week_year_week, [range_as_zero's].DataPoints, [range_as_zero's].Min, [range_as_zero's].Max, [range_as_zero's].Avr
FROM [range_as_zero's] LEFT JOIN source2 ON [range_as_zero's].year_week_year_week = source2.Week
WHERE (((source2.Week) Is Null));

DoCmd.SetWarnings True
End Sub

so there it all is.  turned out to be a biggy...

the questioner has asked about the rounding in the chart but i have not yet been able to master that aspect.