Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
?
Solved

URGENT : Not good at math and need help working out averages - Crystal Reports

Posted on 2006-06-07
7
Medium Priority
?
225 Views
Last Modified: 2010-04-07
0
Comment
Question by:dwe0608
  • 6
7 Comments
 
LVL 17

Expert Comment

by:inthedark
ID: 16850435
I would create the report using MS Excel, easy for math type questions. It is so simple to create a paste link.

What you do is create some queries that provide the data you need. Then it is so simple:


1) Open Excell and create a  Spreadsheet.  Save the Sheet with the name you want.
Keep the sheet open

2) Open access, and create the queries you need.

(see the download sample that I will provide)

3) Right Click on a query and select copy.

Keep the database open.

4) Go back to Excel

Click on Edit, Paste Special, then Select Paste Link.

And now you have your data.

See next post for sample.


0
 
LVL 17

Expert Comment

by:inthedark
ID: 16851030
Have thought of a very easy way for this, using disconnected recordsets. Post code in a few minutes.
0
 
LVL 17

Accepted Solution

by:
inthedark earned 2000 total points
ID: 16851212
1) In VB Create a new project.
2) Past the following code into form1
3) In Project - Refereces set a reference to Microsoft Activex Data Objects

The form uses the data that can be downloaded using the following link:

http://www.pyctalk.org.uk/people.zip 

Move the test.mdb into drive C

-------------------Analysis of data using Disconnected recordsets
Option Explicit

Dim msData As String


Dim ErrN As Long
Dim ErrD As String

Private Sub Form_Load()
Dim CN As ADODB.Connection


' Connect to the database
Set CN = New ADODB.Connection
CN.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\Test.mdb;Persist Security Info=False"
CN.Open

Dim People As ADODB.Recordset
Dim OK

' load the poeple into a recordset
' then disconnect the data from the connection
Dim SQL As String
SQL = "Select * from [People];"
OK = Me.OpenRSFastROOK(CN, People, SQL, True)
If Not OK Then
    MsgBox "Panic"
End If

CN.Close
Set CN = Nothing

' create a place to hold data for each adgeband

Dim AgeBands As ADODB.Recordset
Set AgeBands = New ADODB.Recordset
AgeBands.Fields.Append "AgeBand", adInteger
AgeBands.Fields.Append "Count", adInteger
AgeBands.Fields.Append "Percent", adDouble

AgeBands.Open
AgeBands.Sort = "AgeBand"

'create a place to hold data for each profession
Dim Profs As ADODB.Recordset
Set Profs = New ADODB.Recordset
Profs.Fields.Append "Prof", adInteger
Profs.Fields.Append "Count", adInteger
Profs.Fields.Append "Percent", adDouble
Profs.Fields.Append "TotalAges", adDouble
Profs.Fields.Append "AverageAge", adDouble
Profs.Open
Profs.Sort = "Prof"

Dim lTotal As Long
Dim dblTotalAges As Double
Dim lAbsPeriod As Long

' get the absolute period for the current month
lAbsPeriod = AbsolutePeriod(Date)

' loop through the people
People.MoveFirst
Do While Not People.EOF
    Dim lAge As Long
    Dim lAgeBand As Long
   
    ' claculate age in months
    lAge = lAbsPeriod - AbsolutePeriod(People("DOB"))
    ' get age in years
    lAge = Int(lAge / 12)
    lAgeBand = Int(lAge / 5) * 5
   
    ' Update the AgeBand data
    OK = FindOK(AgeBands, "AgeBand=" + CStr(lAgeBand))
    If Not OK Then
        ' this ageband not found so create a new one
        AgeBands.AddNew
        AgeBands("AgeBand") = lAgeBand
        AgeBands("Count") = 0
        AgeBands("Percent") = 0
    End If
   
    AgeBands("Count") = AgeBands("Count") + 1
    AgeBands.UpdateBatch
   
   
    Dim lProf As Long
    lProf = People("Prof")
   
    OK = FindOK(Profs, "Prof=" + CStr(lProf))
    If Not OK Then
        Profs.AddNew
        Profs("Prof") = lProf
        Profs("Count") = 0
        Profs("Percent") = 0
        Profs("TotalAges") = 0
        Profs("AverageAge") = 0
    End If
    Profs("Count") = Profs("Count") + 1
    Profs("TotalAges") = Profs("TotalAges") + lAge
    Profs.UpdateBatch
   
    ' claculate overall totals
    dblTotalAges = dblTotalAges + lAge
    lTotal = lTotal + 1 ' total the overall number of people
    People.MoveNext
Loop


' Now calculate percentages

AgeBands.MoveFirst
Do While Not AgeBands.EOF
   
    ' calculate the percentage of people at this age band
    AgeBands("Percent") = Round(100# * CDbl(AgeBands("Count")) / CDbl(lTotal), 2)
   
    ' calculate the percentage of people at this age band
    AgeBands("Percent") = Round(100# * CDbl(AgeBands("Count")) / CDbl(lTotal), 2)
   
   
    AgeBands.MoveNext
Loop


Profs.MoveFirst
Do While Not Profs.EOF
   
    ' calculate percentage of total
    Profs("Percent") = Round(100# * CDbl(Profs("Count")) / CDbl(lTotal), 2)
   
    ' calculate average age
    Profs("AverageAge") = Round(Profs("TotalAges") / Profs("Count"), 2)
   
    Profs.MoveNext
Loop

' Prepare output

zAdd "Statistics"
zAdd ""
zAdd ""
' Overall totals summary

' create column headings
zAdd "Total" + vbTab + "Overal"
zAdd "People" + vbTab + "Ave.Age"

zAdd CStr(lTotal) + vbTab + Format(dblTotalAges / lTotal, "0.00")

zAdd ""
zAdd ""

' Age Bands
zAdd "Summary by Age Band"
zAdd ""
zAdd "Age" + vbTab + "No Of" + vbTab + "Percentage"
zAdd "Band" + vbTab + "People" + vbTab + "Of Total"

AgeBands.MoveFirst
Do While Not AgeBands.EOF
    zAdd Format(AgeBands("AgeBand"), "0") + vbTab _
        + Format(AgeBands("Count"), "0") + vbTab _
        + Format(AgeBands("Percent"), "0.00")
       
   
    AgeBands.MoveNext
Loop


' SUmmary by profession
zAdd ""
zAdd ""

' Age Bands
zAdd "Summary by Age Profession"
zAdd ""
zAdd "Prof" + vbTab + "No Of" + vbTab + "Percentage"
zAdd "Code" + vbTab + "People" + vbTab + "Of Total"

Profs.MoveFirst
Do While Not Profs.EOF
    zAdd Format(Profs("Prof"), "0") + vbTab _
        + Format(Profs("Count"), "0") + vbTab _
        + Format(Profs("Percent"), "0.00")
    Profs.MoveNext
Loop

' Slap the data into excel

OK = ExcelCreateOK(msData)


' Clean Up
Set People = Nothing
Set AgeBands = Nothing


Set CN = Nothing



End Sub
Function FindOK(RS As ADODB.Recordset, psCondition As String) As Boolean

' Incase you need more complex stuff
    ' Direction constants.
    '   adSearchBackward
    '   adSearchForward
    ' Start Point
    '   adBookmarkCurrent
    '   adBookmarkFirst
    '   adBookmarkLast

' Finds a record
' see: http://www.devguru.com/Technologies/ado/quickref/recordset_find.html

On Error Resume Next

If Not RS.BOF Then
    RS.MoveFirst
End If

RS.Find psCondition, , adSearchForward
If Err.Number <> 0 Then
   ErrN = Err.Number
   ErrD = Err.Description
   FindOK = False
Else
    If (RS.BOF) Or (RS.EOF) Then
        FindOK = False
    Else
        FindOK = True
    End If
End If

End Function



Public Function AbsolutePeriod(FromDate As Date) As Long

' Converts a date to the number of months since year 0
' Msgbox "Transacion is " +cstr(GF.AbsolutePeriod(Now)-GF.AbsolutePeriod(RS("Trans Date")+" months old"


Dim lStartMonth As Long
Dim lStartYear As Long

lStartMonth = DatePart("m", FromDate)
lStartYear = DatePart("yyyy", FromDate)
AbsolutePeriod = lStartYear * 12 + lStartMonth - 1

End Function


Public Function OpenRSFastROOK(CN As ADODB.Connection, RS As ADODB.Recordset, SQL As String, Optional pbDisconnect As Boolean = False) As Boolean

' Open Recordset Readonly returns status true=wroked false = failed

Set RS = New ADODB.Recordset

On Error Resume Next

Err.Clear
RS.CursorLocation = adUseClient
RS.Open SQL, CN, adOpenStatic + adOpenForwardOnly, adLockReadOnly

If Err.Number <> 0 Then
   
    OpenRSFastROOK = False
    Set RS = Nothing
    ErrN = Err.Number
    ErrD = Err.Description
   
Else
    OpenRSFastROOK = True
    If pbDisconnect Then
        RS.ActiveConnection = Nothing
    End If
End If

End Function

Public Function ExcelCreateOK(FromData As String, Optional psFileName As String = "") As Boolean

' Fires up Excel and pastes data into a new workbook
' See class zExcel for a better version of this which allows formatting
' of columns

' OK = GF.ExcelCreateOK(sDataToPaste)

Const zxlNormal = -4143

Dim IDE As Boolean

' Are we running in IDE or EXE mode?
On Error Resume Next
Err.Clear
Debug.Print 1 / 0
If Err.Number <> 0 Then
    IDE = True
End If
If IDE Then
    On Error GoTo 0
Else
    On Error GoTo ErrorTrap
End If

' Create the Excel objects
Dim ExcelApp ' As Excel.Application
On Error Resume Next

Set ExcelApp = CreateObject("Excel.Application")


Dim WB ' As Excel.Workbook

' If no filename make visible to hold on screen
ExcelApp.Visible = Len(psFileName) = 0

' create a blank sheet
Set WB = ExcelApp.Workbooks.Add

' set app focus to the new sheet
WB.Activate
ExcelApp.Range("A1").Select

' stuff the data onto clipboard
Clipboard.Clear
Clipboard.SetText FromData

' move clipboard to Excel
ExcelApp.ActiveSheet.Paste
DoEvents
Clipboard.Clear ' release memory
DoEvents
If Len(psFileName) > 0 Then
   
    ' if a file name save and close Excel
    ExcelApp.ActiveWorkbook.SaveAs FileName:=psFileName, FileFormat:=zxlNormal, Password:="", _
        WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
    ExcelApp.ActiveWorkbook.Close
    ExcelApp.Quit
    Set WB = Nothing
    Set ExcelApp = Nothing
Else
    ' Allow Excel to stay on screen
    Set WB = Nothing
    Set ExcelApp = Nothing
End If

ExcelCreateOK = True
Exit Function

ErrorTrap:
ErrN = Err.Number
ErrD = Err.Description
On Error Resume Next

ExcelCreateOK = False

End Function


Private Sub zAdd(psMessage As String)

msData = msData + psMessage + vbCrLf

End Sub




0
Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

 
LVL 17

Expert Comment

by:inthedark
ID: 16851226
If you must use Crystal Reps adabpt the section prepare outout to save the data into a tables for AgeBands and Profession results. Then create the report from the simple tables.
0
 
LVL 1

Author Comment

by:dwe0608
ID: 16858107
I am giving this a try now, so far so good ...
0
 
LVL 17

Expert Comment

by:inthedark
ID: 16859410
You should not need to change much just field names used in the People recordset: "DOB" and "Prof" & the table name used in the select statement.


0
 
LVL 17

Expert Comment

by:inthedark
ID: 16892530
How did it go?
0

Featured Post

Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

Question has a verified solution.

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

Enums (shorthand for ‘enumerations’) are not often used by programmers but they can be quite valuable when they are.  What are they? An Enum is just a type of variable like a string or an Integer, but in this case one that you create that contains…
I was working on a PowerPoint add-in the other day and a client asked me "can you implement a feature which processes a chart when it's pasted into a slide from another deck?". It got me wondering how to hook into built-in ribbon events in Office.
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
Suggested Courses

578 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