I am working on a database that I didn't create. I was asked to create a report which I though wasn't a big deal. However the database is setup completely different then what I am used to and everything is written in code. What I have so far is the end user choses a Quarter date, either 1, 2, 3, 4 or Annual. They choose to print Therapy Report. The code should then collect data based on the date, each therapist, all services that each therapist has provided and a summary of survey questions regarding that therapist and those services. Can anyone send me a link to any online help that shows how to create reports in VBA that allows multiple pieces of criteria. What I have so far is based on another report that I generated but doesn't work for multiple pieces of criteria. This code allows me to pick what report to print and what date to use but it doesn't allow me to print using the criteria listed above. OPProvides are my lists of Therapist. OPServices are the services they provide, Qtext is the questions on the survey, Data is the main table where the surveys are entered. Tally is the table where the questions are tallied. So 5 for excellent services and 1 for poor service. Here is what I have so far:
Code:
Private Sub Command1_Click()
Dim db As Database
Dim rsdata As Recordset, rstally As Recordset
Dim rskey As Recordset, rstext As Recordset
Dim Bdate As Date
Dim Edate As Date
Dim tst As String
Dim atch As String
Dim txt As String, cnt As Integer
Dim ans As Integer, j As Integer, k As Integer
Dim xkey As String, xmonth As Integer, xquarter As Integer, xyear As Integer
Dim xtype As Integer
Dim keywant As String, qtrwant As Integer, yerwant As Integer
Dim survey_form As Integer 'indicates which question set to use
Dim qcvt(12) As Integer
Dim thebatch As String
Dim S(20), btch As String
Dim scores(20, 6) As Long
Dim flipit As Boolean, refcode As String
Dim msg, style, response
Set db = CurrentDb()
Set rsdata = db.OpenRecordset("Data", dbOpenTable)
rsdata.Index = "IDNmb"
Set rstally = db.OpenRecordset("Tally", dbOpenTable)
Set rskey = db.OpenRecordset("OPProviders", dbOpenTable)
rskey.Index = "OPNmb"
Set rskey = db.OpenRecordset("OPServices", dbOpenTable)
rskey.Index = "RecNmb"
Set rstext = db.OpenRecordset("QText", dbOpenTable)
rstext.Index = "RCode"
qcvt(1) = 1
qcvt(2) = 1
qcvt(3) = 1
qcvt(4) = 2
qcvt(5) = 2
qcvt(6) = 2
qcvt(7) = 3
qcvt(8) = 3
qcvt(9) = 3
qcvt(10) = 4
qcvt(11) = 4
qcvt(12) = 4
'--------------------
rskey.MoveFirst
Do While Not rskey.EOF
keywant = rskey!Key
survey_form = 9
qtrwant = Forms!PreRep!TheQuarter
yerwant = Forms!PreRep!TheYear
'rstally!Abatch = rskey!Batch
Forms!Main!RpTitle = "Therapy Services - " & rskey!Name
GoSub DoTally
msg = rskey!Name & " - Print ?"
style = vbYesNo + vbCritical + vbDefaultButton2
response = MsgBox(msg, style)
If response = vbYes Then ' User chose Yes.
DoCmd.OpenReport "Report1" ', acViewPreview
DoCmd.OpenReport "Report2" ', acViewPreview
End If
rskey.MoveNext
Loop
'--------------------
rsdata.Close
rstally.Close
rskey.Close
rstext.Close
Set rsdata = Nothing
Set rstally = Nothing
Set rskey = Nothing
Set rstext = Nothing
Set db = Nothing
Exit Sub
'=================================================
DoTally:
DoCmd.SetWarnings False
DoCmd.RunSQL "delete * from Tally;"
For j = 1 To 20
For k = 1 To 6
scores(j, k) = 0
Next k
Next j
DoCmd.SetWarnings True
rsdata.MoveFirst
Do While Not rsdata.EOF
If Len(rsdata!Batch) = 7 Then
xmonth = Val(Left(rsdata!Batch, 2))
xquarter = qcvt(xmonth)
If qtrwant = 5 Then xquarter = 5 'avz
xyear = Val(Mid(rsdata!Batch, 4, 4))
xtype = Nz(rsdata!Type, " ")
xkey = Nz(rsdata!Service, " ")
Else
xquarter = 0
End If
If (xtype = 9) And (xkey = keywant) And (xquarter = qtrwant) And (xyear = yerwant) Then
S(1) = rsdata!Q1
S(2) = rsdata!Q2
S(3) = rsdata!Q3
S(4) = rsdata!Q4
S(5) = rsdata!Q5
S(6) = rsdata!Q6
S(7) = rsdata!Q7
S(8) = rsdata!Q8
S(9) = rsdata!Q9
S(10) = rsdata!Q10
S(11) = rsdata!Q11
S(12) = rsdata!Q12
S(13) = rsdata!Q13
S(14) = rsdata!Q14
S(15) = rsdata!Q15
S(16) = rsdata!Q16
S(17) = rsdata!Q17
S(18) = rsdata!Q18
S(19) = rsdata!Q19
S(20) = rsdata!Q20
For k = 1 To 20
If Nz(S(k), 0) > 0 Then
scores(k, S(k)) = scores(k, S(k)) + 1
scores(k, 6) = scores(k, 6) + 1
End If
Next k
End If
rsdata.MoveNext
Loop
'--------------
For k = 1 To 20
rstally.AddNew
'rstally!tbatch = thebatch 'avz
rstally!SurveyID = 1
rstally!QNmb = k
refcode = Format(survey_form, "00") & Format(k, "00")
rstally!RCode = refcode
rstext.Seek "=", refcode
If rstext.NoMatch Then
flipit = False
Else
flipit = rstext!Flip
End If
If flipit = True Then
rstally!VeryGood = scores(k, 1)
rstally!Good = scores(k, 2)
rstally!Fair = scores(k, 3)
rstally!Poor = scores(k, 4)
rstally!Excellent = scores(k, 5)
rstally!Total = scores(k, 6)
If scores(k, 6) > 0 Then
rstally!VeryGoodPct = scores(k, 1) / scores(k, 6)
rstally!GoodPct = scores(k, 2) / scores(k, 6)
rstally!FairPct = scores(k, 3) / scores(k, 6)
rstally!PoorPct = scores(k, 4) / scores(k, 6)
rstally!ExcellentPct = scores(k, 5) / scores(k, 6)
End If
Else
rstally!Poor = scores(k, 1)
rstally!Fair = scores(k, 2)
rstally!Good = scores(k, 3)
rstally!VeryGood = scores(k, 4)
rstally!Excellent = scores(k, 5)
rstally!Total = scores(k, 6)
If scores(k, 6) > 0 Then
rstally!PoorPct = scores(k, 1) / scores(k, 6)
rstally!FairPct = scores(k, 2) / scores(k, 6)
rstally!GoodPct = scores(k, 3) / scores(k, 6)
rstally!VeryGoodPct = scores(k, 4) / scores(k, 6)
rstally!ExcellentPct = scores(k, 5) / scores(k, 6)
End If
End If
rstally.Update
Next k
'--------------
Return
End Sub
/[code]