Hello,
I am trying to create a report that does a Unit fiscal Year Comparison with the current year totals by month, by person. The queries I have set up work individually but the problem is when the comparison is done the current year totals don't work correctly. The problem is the FY2012 has 628 names to compare and the current year has 382 names. My code calculates the FY2012 totals by name and puts them in Col 19 of the spreadheet that I am using. I can't figure out how to delete just the names that don't match the FY2013. Any help is appreciated.
Tom
I am trying to create a report that does a Unit fiscal Year Comparison with the current year totals by month, by person. The queries I have set up work individually but the problem is when the comparison is done the current year totals don't work correctly. The problem is the FY2012 has 628 names to compare and the current year has 382 names. My code calculates the FY2012 totals by name and puts them in Col 19 of the spreadheet that I am using. I can't figure out how to delete just the names that don't match the FY2013. Any help is appreciated.
Tom
Code:
Dim strTemplate1 As String
Dim strTemplate2 As String
Dim strSQL As String
Dim rst As DAO.Recordset
Dim iRw As Integer
Dim iCol As Integer
Dim Z As Integer
Dim Y As Integer
Dim strCurRP As String
Dim strGrpRP As String
Dim strCurPOS As String
Dim strGrpPOS As String
Dim strCurM As String
Dim strGrpM As String
Dim strSaveName As String
Dim strSheetName As String
Dim strTemplateSheetName As String
Dim iNumMon As Integer
Dim intFyTot As Integer
iNumMon = GetMonthTot()
'*********************************************************************************************************************************
'*************************************** PROCEDURES SHEET ************************************************************************
'*********************************************************************************************************************************
' Total Procedures
strTemplateSheetName = "RefPhys"
' Open Excel
Call XLCreate
'Define Template
strTemplate1 = "\\AutoRpts\_RptSets\OTHER\INR\Tools\RefProv.xlt"
' Open Template
goXL.Workbooks.Open Filename:=strTemplate1
'Calculate Previous Year Totals
strSQL = "SELECT [dbo_rpt_FYInfo].fydiff,tbl_RptData.RefProvider,tbl_RptData.refgrp,tbl_RptData.UCI,[dbo_rpt_FYInfo].uci,tbl_RptData.yr,[dbo_rpt_FYInfo].fy,tbl_RptData.rptpd,[dbo_rpt_FYInfo].rptpd, Sum(tbl_RptData.Unit) AS u " & _
"FROM tbl_RptData INNER JOIN dbo_rpt_FYInfo ON tbl_RptData.UCI = [dbo_rpt_FYInfo].uci And tbl_RptData.rptpd = [dbo_rpt_FYInfo].rptpd And tbl_RptData.yr = [dbo_rpt_FYInfo].fy " & _
"GROUP BY dbo_rpt_FYInfo.fydiff,tbl_RptData.UCI,[dbo_rpt_FYInfo].uci,tbl_RptData.RefProvider,tbl_RptData.refgrp,tbl_RptData.yr,[dbo_rpt_FYInfo].fy,tbl_RptData.rptpd,[dbo_rpt_FYInfo].rptpd " & _
"HAVING [dbo_rpt_FYInfo].fydiff =1 And Sum(tbl_RptData.Unit) <> 0 " & _
"ORDER BY tbl_RptData.RefProvider;"
Set rst = CurrentDb.OpenRecordset(strSQL, dbopensnapshot)
If Not rst.EOF Then
With rst
.MoveLast
.MoveFirst
End With
' Initialize
iRw = 6
With goXL.ActiveSheet
.Cells(1, 1).Value = "REFERRING PHYSICIAN REFERRED (Units)"
.Cells(3, 1).Value = "Fiscal " & (rst![fy])
End With
strCurRP = (rst![RefProvider])
strGrpRP = (rst![RefProvider])
For Y = 1 To rst.RecordCount
If ((rst![fydiff]) = 1) Then
iCol = 17
End If
With goXL.ActiveSheet
.Cells(iRw, 1).Value = strCurRP
.Cells(iRw, 2).Value = (rst![refgrp])
If strCurRP = strGrpRP Then intFyTot = (rst![u]) + intFyTot
.Cells(iRw, iCol).Value = intFyTot
End With
rst.MoveNext
If Not rst.EOF Then
strCurRP = (rst![RefProvider])
If (strCurRP <> strGrpRP) Then
iRw = iRw + 1
strGrpRP = strCurRP
intFyTot = 0
End If
End If
Next Y
End If
rst.Close
Set rst = Nothing
' Delete Extra Rows
With goXL
.Rows("" & (iRw + 1) & ":1499").Select
Selection.Delete Shift:=xlUp
.Cells(4, 1).Select
End With
'Current Year Totals by month
strSQL = "SELECT [dbo_rpt_FYInfo].fydiff,[dbo_rpt_FYInfo].imp,[dbo_rpt_FYInfo].fyord,[dbo_rpt_FYInfo].fy,tbl_RptData.RefProvider,tbl_RptData.refgrp,tbl_RptData.rptpd,Sum(tbl_RptData.Unit) AS u " & _
"FROM tbl_RptData INNER JOIN dbo_rpt_FYInfo ON tbl_RptData.rptpd = [dbo_rpt_FYInfo].rptpd AND tbl_RptData.UCI = [dbo_rpt_FYInfo].uci " & _
"GROUP BY tbl_RptData.RefProvider,tbl_RptData.refgrp,tbl_RptData.rptpd,[dbo_rpt_FYInfo].rptpddiff,[dbo_rpt_FYInfo].imp,[dbo_rpt_FYInfo].fydiff,[dbo_rpt_FYInfo].fy,[dbo_rpt_FYInfo].fyord " & _
"HAVING [dbo_rpt_FYInfo].fydiff =0 And [dbo_rpt_FYInfo].imp = 1 And [dbo_rpt_FYInfo].rptpddiff >=0 And Sum(tbl_RptData.Unit) <> 0 " & _
"ORDER BY tbl_RptData.RefProvider,tbl_RptData.refgrp,tbl_RptData.rptpd,[dbo_rpt_FYInfo].fyord,[dbo_rpt_FYInfo].fydiff;"
Set rst = CurrentDb.OpenRecordset(strSQL, dbopensnapshot)
If Not rst.EOF Then
With rst
.MoveLast
.MoveFirst
End With
' Initialize
iRw = 6
'Name Sheet
With goXL.Sheets(strTemplateSheetName)
.Name = "RefProv_Tot_Units"
.Cells(3, 1).Value = "Fiscal " & (rst![fy])
.Cells(1, 19) = iNumMon
End With
strCurRP = (rst![RefProvider])
strGrpRP = (rst![RefProvider])
' Add Data
For Z = 1 To rst.RecordCount
iCol = ((rst![fyord]) + 2)
With goXL.ActiveSheet
.Cells(iRw, 1).Value = strCurRP
.Cells(iRw, 2).Value = (rst![refgrp])
.Cells(iRw, iCol).Value = (rst![u])
End With
rst.MoveNext
If Not rst.EOF Then
strCurRP = (rst![RefProvider])
If (strCurRP <> strGrpRP) Then
iRw = iRw + 1
strGrpRP = strCurRP
End If
End If
Next Z
' ' Delete Extra Rows
' With goXL
' .Rows("" & (iRw + 1) & ":1499").Select
' Selection.Delete Shift:=xlUp
' .Cells(4, 1).Select
' End With
End If
rst.Close
Set rst = Nothing