Code:
Private Sub Command20_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 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 btch As String
Dim S(20) As Long
Dim scores(20, 6) As Long
Dim v1 As Long, v2 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("Clinics", 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 = 2 'Clinic Survey Form
qtrwant = Forms!PreRep!TheQuarter
yerwant = Forms!PreRep!TheYear
Forms!Main!RpTitle = "Clinic Survey - " & 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
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)
xyear = Val(Mid(rsdata!Batch, 4, 4))
xtype = Nz(rsdata!Type, " ")
xkey = Nz(rsdata!Clinic, " ")
Else
xquarter = 0
End If
If (xtype = 2) And (xkey = keywant) And (xquarter = qtrwant) And (xyear = yerwant) Then
S(1) = Nz(rsdata!Q1)
S(2) = Nz(rsdata!Q2)
'---------
If S(2) > 9 Then 'This If section might be the cause of the problem, but I am unsure of what is happening here. Can anyone explain?
v1 = S(2)
v2 = (v1 / 10)
S(2) = v1 - (v2 * 10)
End If
'---------
S(3) = Nz(rsdata!Q3)
S(4) = Nz(rsdata!Q4)
S(5) = Nz(rsdata!Q5)
S(6) = Nz(rsdata!Q6)
S(7) = Nz(rsdata!Q7)
S(8) = Nz(rsdata!Q8)
S(9) = Nz(rsdata!Q9)
S(10) = Nz(rsdata!Q10)
S(11) = Nz(rsdata!Q11)
S(12) = Nz(rsdata!Q12)
S(13) = Nz(rsdata!Q13)
S(14) = Nz(rsdata!Q14)
S(15) = Nz(rsdata!Q15)
S(16) = Nz(rsdata!Q16)
S(17) = Nz(rsdata!Q17)
S(18) = Nz(rsdata!Q18)
S(19) = Nz(rsdata!Q19)
S(20) = Nz(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!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!