A
ambushsinger
I'm trying to programmatically insert a new worksheet into an Excel workbook
from Access. However I keep getting a "subscript out of range" message.
Here's the code below...any suggestions???
Tom
Private Sub AmrixPrescriberTargeting(Level As eLevel)
'Local variables
Dim rsGeography As New ADODB.Recordset
Dim cmdData As New ADODB.Command
Dim rsCheck As New ADODB.Recordset
Dim rsData As New ADODB.Recordset
Dim prmGeography As New ADODB.Parameter
Dim sGeography As String, sLevel As String
Dim i As Long, iRow As Long, iRecords As Long, iLastColumn As Long
Dim iLastRow As Long, iLastCol As Long, iTotalRow As Long
Dim xl As Excel.Application
Dim wkb As Excel.Workbook, wks As Excel.Worksheet ' , wksGraph As
Excel.Worksheet
Dim sSql As String
Dim dtEnd As Date, dtTemp As Date
Dim iSheet As Integer
'' Column Location for Prescriber Targeting TAB
Const cPT_Territory = 1
Const cPT_SaleRepFullName = 2
Const cPT_ME_# = 3
Const cPT_PDRP_Flag = 7
Const cPT_Amrix_Spec_Grp = 8
Const cPT_CNS_Calls_YTD = 14
Const cPT_Invt1_Calls_YTD = 18
Const cPT_Invt1_Calls_3Mth = 19
Const cPT_Amrix_Oct07_TRx = 20
Const cPT_Amrix_Nov07_TRx = 21
Const cPT_Amrix_Dec07_TRx = 22
Const cPT_Amrix_3Mth_TRx = 23
Const cPT_Amrix_3Mth_Samples = 24
Const cPT_Amrix_3Mth_Ratio = 25
Const cPT_Amrix_6_Mth_TRx = 26
Const cPT_Amrix_6_Mth_Unit_Decile = 27
Const Cyclobenzaprine_HCL_6_Mth_TRx = 30
Const Cyclobenzaprine_HCL_6_Mth_Unit_Decile = 31
Const cPT_Soma_250_6_Mth_TRx = 34
Const cPT_Soma_250_6_Mth_Unit_Decile = 35
Const cPT_MR_Market_6_Mth_TRx = 38
Const cPT_Provigil_6_Mth_TRx = 40
Const cPT_Provigil_6_Mth_Unit_Decile = 41
Const cPT_Amrix_Rep_Rank = 44
'' Column Location for Target Overlp TAB
Const cTO_Territory = 1
Const cTO_SaleRepFullName = 2
Const cTO_ME_# = 3
Const cTO_PDRP_Flag = 10
'***** column Location for Trend Tab
Const cTR_Territory = 1
Const cTR_FullName = 2
Const cTR_ME_Num = 3
Const cTR_DEA_Num = 4
Const cTR_Last_Name = 5
Const cTR_First_Name = 6
Const cTR_PDRP_Flag = 7
Const cTR_Amrix_Report_Group = 8
Const cTR_Address = 9
Const cTR_City = 10
Const cTR_State_Abbrev = 11
Const cTR_ZIP_Code = 12
Const cTR_Amrix_Trx_CNT_CURR_YTD = 13
Const cTR_CNS_Detls_YTD = 14
Const cTR_Amrix = 15
Const cTR_CNS_Detls_3 = 16
Const cTR_Rx_Per_Call = 17
Const cTR_Amrix_Trx_CNT_SEM01 = 18
Const cTR_Amrix_Trx_QTY_SEM01 = 19
Const cTR_Amrix_Trx_Cnt_12 = 20
Const cTR_Amrix_Trx_Cnt_11 = 21
Const cTR_Amrix_Trx_Cnt_10 = 22
Const cTR_Amrix_Trx_Cnt_09 = 23
Const cTR_Amrix_Trx_Cnt_08 = 24
Const cTR_Amrix_Trx_Cnt_07 = 25
Const cTR_Amrix_Trx_Cnt_06 = 26
Const cTR_Amrix_Trx_Cnt_05 = 27
Const cTR_Amrix_Trx_Cnt_04 = 28
Const cTR_Amrix_Trx_Cnt_03 = 29
Const cTR_Amrix_Trx_Cnt_02 = 30
Const cTR_Amrix_Trx_Cnt_01 = 31
Const cTR_Amrix_Trx_CNT_Cal_QTR04 = 32
Const cTR_Amrix_Trx_CNT_Cal_QTR03 = 33
Const cTR_Amrix_Trx_CNT_Cal_QTR02 = 34
Const cTR_Amrix_Trx_CNT_Cal_QTR01 = 35
Const cTR_Amrix_Trx_CNT_YR01 = 36
'' Column Location for PAYER TAB
Const cPY_Territory = 1
Const cPY_SaleRepFullName = 2
Const cPY_ME_# = 3
Const cPY_PDRP_Flag = 8
Const cPY_Amrix_Spec_Grp = 9
Const cPY_CNS_Calls_YTD = 15
Const cPY_Flexeril_6_Mth_TRx = 18
Const cPY_Amrix_Oct07_TRx = 19
Const cPY_Amrix_Dec07_TRx = 21
Const cPY_Amrix_6_Mth_TRx = 22
Const cPY_Amrix_6_Mth_Unit_Decile = 23
Const cPY_MR_Market_6_Mth_TRx = 30
Const cPY_Provigil_6_Mth_TRx = 32
Const cPY_Provigil_6_Mth_Unit_Decile = 33
Dim bRealigned As Boolean
'' Column Location for Target Overlap Report
sShellFile = sDefaultPath & "TEMPLATE\" & sABMTemplateFile
bRealigned = IIf(InStr(sReportName, "Realigned") > 0, True, False)
dtEnd = DateSerial(iYear1, iMonth, 1)
'''''''''''''''''''''''''''''''
''' Select the Geography that will drive the process
''' based on the Organization Level.
'''''''''''''''''''''''''''''''
Select Case Level
Case EL_REGION
sLevel = "Region"
sSql = "select distinct Region FROM [Region Reports]"
Case EL_AREA
sLevel = "Area"
sSql = "select distinct left([Area],4) FROM [Area Reports]"
Case EL_TERRITORY
sLevel = "Territory"
sSql = "select Territory FROM [Territory Reports] order by
Territory"
Case EL_NATION
sLevel = "Top 300"
sSql = "select '2' " 'Dummy SQL to prevent interruption
of flow
Case Else
' should never get here
MsgBox "Unable to process selected level: " & Level
Stop
End Select
rsGeography.Open sSql, cnn, adOpenStatic, adLockReadOnly
Set xl = New Excel.Application
Do While Not rsGeography.EOF
sGeography = rsGeography.Fields(0).Value
Debug.Print "sGeography = " & sGeography
' startingStep sGeography, "Spreadsheet", "AmrixPrescriberTargeting"
setReportStatusBar "Creating ""Amrix Prescriber Targeting"" report
for " & sLevel & " " & sGeography
rsCheck.Open "select count(1) from [Target Amrix Demographic] where
territory_num like '" & _
sGeography & "%'", cnn, adOpenStatic, adLockReadOnly
iRecords = rsCheck.Fields(0)
rsCheck.Close
If iRecords = 0 Then
Debug.Print "Skipping " & sGeography & " due to a lack of
records (probably realigned)"
Else
xl.Workbooks.Open sShellFile
Set wkb = xl.ActiveWorkbook
setWorkbookComments wkb, sGeography
If sLevel = "Top 300" Then
sGeography = "Top 300"
End If
sFileName = sDefaultPath & "Field\PrescTarg\Amrix\" & sGeography
& ".xls"
wkb.SaveAs sFileName
'''''''''''''''''''''''''''''''
''' Amrix Targeting Worksheet
'''''''''''''''''''''''''''''''
Set wks = wkb.Worksheets("Amrix Targeting")
With wks
.Name = sGeography & " " & .Name
.Activate
' KMB 2008-01-15 Added 3 month trend
setMonthColumnHeadings wks, cPT_Amrix_Dec07_TRx, dtEnd, 3,
1, "Amrix", "TRx"
hideMonthColumnsBeforeLaunch wks, cPT_Amrix_Dec07_TRx,
dtEnd, #11/1/2007#, 3, 1
If sLevel <> "Top 300" Then
setupQueryParameter cmdData,
"qrySelAmrixTargetingReport", "TERR", sGeography & "%"
Else
setupQueryParameter cmdData,
"qrySelAmrixTargetingReportTop300", "TERR", sGeography & "%"
End If
Set rsData = cmdData.Execute
.Range("A2").CopyFromRecordset rsData
rsData.Close
iLastRow = xl_LastRow(wks)
iLastCol = xl_LastCol(wks)
overwritePDRP wks, iLastRow, _
cPT_PDRP_Flag, _
cPT_Amrix_Oct07_TRx, _
cPT_MR_Market_6_Mth_TRx
overwritePDRP wks, iLastRow, _
cPT_PDRP_Flag, _
cPT_Provigil_6_Mth_TRx, _
cPT_Provigil_6_Mth_Unit_Decile
overwriteSurgeons wks, iLastRow, _
cPT_Amrix_Spec_Grp, _
cPT_Provigil_6_Mth_TRx, _
cPT_Provigil_6_Mth_Unit_Decile
totalAndCount wks, 1, iLastRow, _
cPT_CNS_Calls_YTD, _
cPT_Provigil_6_Mth_TRx
' blank out total rows for decile columns
For i = cPT_Amrix_6_Mth_Unit_Decile To
cPT_Provigil_6_Mth_Unit_Decile Step 2
.Cells(iLastRow + 2, i) = ""
Next i
' blank out sum of the Ratio. Sum of ratio does not make
sense in this case.
.Cells(iLastRow + 2, cPT_Amrix_3Mth_Ratio) = ""
.Cells(iLastRow + 3, cPT_Amrix_3Mth_Ratio) = ""
.Columns(cPT_ME_#).EntireColumn.Hidden = True
If Level = EL_TERRITORY Then
.Columns(cPT_Territory).EntireColumn.Hidden = True
.Columns(cPY_SaleRepFullName).EntireColumn.Hidden = True
End If
xl.Run "Casino_Slots"
.Range("c1").Select
scrollToUpperLeft wks
.PageSetup.CenterFooter = "Current Data Month = " & sMonth1
& " " & iYear1
End With
'''''''''''''''''''''''''''''''
''' Target Overlap Worksheet. New TAB 02Feb08.
''' Shows a consolidated view of target overlap for PCS and
inVentiv
'''''''''''''''''''''''''''''''
Set wks = wkb.Worksheets("PCS-inVentiv Targets")
With wks
.Name = sGeography & " " & .Name
.Activate
If sLevel <> "Top 300" Then
setupQueryParameter cmdData,
"qrySelAmrixTargetingOverlapReport", "TERR", sGeography & "%"
Else
setupQueryParameter cmdData,
"qrySelAmrixTargetingOverlapReportTop300", "TERR", sGeography & "%"
End If
Set rsData = cmdData.Execute
If rsData.EOF And rsData.BOF Then
' TODO: put out a message saying there is no overlap
Else
rsData.MoveFirst
.Range("A2").CopyFromRecordset rsData
rsData.Close
End If
.Columns(cTO_ME_#).EntireColumn.Hidden = True
If Level = EL_TERRITORY Then
.Columns(cTO_Territory).EntireColumn.Hidden = True
.Columns(cPY_SaleRepFullName).EntireColumn.Hidden = True
End If
.Range("c1").Select
scrollToUpperLeft wks
.PageSetup.CenterFooter = "Current Data Month = " & sMonth1
& " " & iYear1
End With
'''''''''''''''''''''''''''''''
''' Payer Worksheet. New TAB 02Feb08.
''' Shows each Payer Plan for each ME.
'''''''''''''''''''''''''''''''
Set wks = wkb.Worksheets("Payer")
If Level = EL_AREA Or Level = EL_TERRITORY Or Level = EL_NATION
Then
With wks
.Activate
If sLevel <> "Top 300" Then
setupQueryParameter cmdData,
"qrySelAmrixTargetingPayerReport", "TERR", sGeography & "%"
Else
setupQueryParameter cmdData,
"qrySelAmrixTargetingPayerReportTop300", "TERR", sGeography & "%"
End If
Set rsData = cmdData.Execute
rsData.MoveFirst
.Range("A2").CopyFromRecordset rsData
rsData.Close
iLastRow = xl_LastRow(wks)
iLastCol = xl_LastCol(wks)
overwritePDRP wks, iLastRow, _
cPY_PDRP_Flag, _
cPY_Flexeril_6_Mth_TRx, _
cPY_Flexeril_6_Mth_TRx
.Columns(cPY_ME_#).EntireColumn.Hidden = True
If Level = EL_TERRITORY Then
.Columns(cPY_Territory).EntireColumn.Hidden = True
.Columns(cPY_SaleRepFullName).EntireColumn.Hidden =
True
End If
wkb.Worksheets(1).Activate
xl.Run "AutoComment"
wkb.Worksheets(2).Activate
xl.Run "AutoComment"
wkb.Worksheets("Payer").Activate
.Range("c1").Select
scrollToUpperLeft wks
.Name = sGeography & " " & .Name
End With
Else
wks.Visible = xlSheetHidden
End If '''' If Level = EL_AREA Or Level = EL_TERRITORY Then
Set wks = wkb.Worksheets("Specialty Code Description")
With wks
.Activate
rsData.Open "qrySelSpecialtyCodeListPT", cnn, adOpenStatic,
adLockReadOnly
.Range("A2").CopyFromRecordset rsData
rsData.Close
.Range("c1").Select
scrollToUpperLeft wks
End With
'**********Insert Amrix 12 Month Trend Tab
'********** TJ 09-22-2008 ********************
Set wks = wkb.Worksheets("Amrix 12 Mth TRx Count Trend")
With wks
.Name = sGeography & " Amrix 12 Mth TRx"
.Activate
'setMonthColumnHeadings wks, 34, dtEnd, 12, 1
'.Range("AI1") = sPreBaseQtr
'.Range("AJ1") = sBaseQtr
'.Range("AK1") = sPriorQtr
'.Range("AL1") = sCurrentQtr
If sLevel <> "Top 300" Then
setupQueryParameter cmdData,
"qrySelAmrixTrendTrxReport", "TERR", sGeography & "%"
Else
setupQueryParameter cmdData,
"qrySelAmrixTrendTrxReportTop300", "TERR", sGeography & "%"
End If
Set rsData = cmdData.Execute
rsData.MoveFirst
.Range("A2").CopyFromRecordset rsData
rsData.Close
iLastRow = xl_LastRow(wks)
iLastCol = xl_LastCol(wks)
totalAndCount wks, 1, iLastRow, 13, 18
totalAndCount wks, 1, iLastRow, 22, iLastCol - 2
.Cells(iLastRow + 2, 17) = "" ' blank out total for Rx Per
Call
.Columns(3).EntireColumn.Hidden = False
.Columns(19).EntireColumn.Hidden = True ' hide Takeda CSP
until we get data
If Level = EL_TERRITORY Then
.Columns(cTR_Territory).EntireColumn.Hidden = True
.Columns(cTR_FullName).EntireColumn.Hidden = True
End If
.Range("c1").Select
scrollToUpperLeft wks
.PageSetup.CenterFooter = "Current Data Month = " & sMonth1
& " " & iYear1
End With
'***End 12 month Trend Tab
wkb.Worksheets(sGeography & " Amrix Targeting").Activate
wkb.Save
wkb.Close
End If '''' If iRecords = 0 Then
rsGeography.MoveNext
Loop
setReportStatusBar ""
END_OF_TARGET:
xl.Quit
End Sub
from Access. However I keep getting a "subscript out of range" message.
Here's the code below...any suggestions???
Tom
Private Sub AmrixPrescriberTargeting(Level As eLevel)
'Local variables
Dim rsGeography As New ADODB.Recordset
Dim cmdData As New ADODB.Command
Dim rsCheck As New ADODB.Recordset
Dim rsData As New ADODB.Recordset
Dim prmGeography As New ADODB.Parameter
Dim sGeography As String, sLevel As String
Dim i As Long, iRow As Long, iRecords As Long, iLastColumn As Long
Dim iLastRow As Long, iLastCol As Long, iTotalRow As Long
Dim xl As Excel.Application
Dim wkb As Excel.Workbook, wks As Excel.Worksheet ' , wksGraph As
Excel.Worksheet
Dim sSql As String
Dim dtEnd As Date, dtTemp As Date
Dim iSheet As Integer
'' Column Location for Prescriber Targeting TAB
Const cPT_Territory = 1
Const cPT_SaleRepFullName = 2
Const cPT_ME_# = 3
Const cPT_PDRP_Flag = 7
Const cPT_Amrix_Spec_Grp = 8
Const cPT_CNS_Calls_YTD = 14
Const cPT_Invt1_Calls_YTD = 18
Const cPT_Invt1_Calls_3Mth = 19
Const cPT_Amrix_Oct07_TRx = 20
Const cPT_Amrix_Nov07_TRx = 21
Const cPT_Amrix_Dec07_TRx = 22
Const cPT_Amrix_3Mth_TRx = 23
Const cPT_Amrix_3Mth_Samples = 24
Const cPT_Amrix_3Mth_Ratio = 25
Const cPT_Amrix_6_Mth_TRx = 26
Const cPT_Amrix_6_Mth_Unit_Decile = 27
Const Cyclobenzaprine_HCL_6_Mth_TRx = 30
Const Cyclobenzaprine_HCL_6_Mth_Unit_Decile = 31
Const cPT_Soma_250_6_Mth_TRx = 34
Const cPT_Soma_250_6_Mth_Unit_Decile = 35
Const cPT_MR_Market_6_Mth_TRx = 38
Const cPT_Provigil_6_Mth_TRx = 40
Const cPT_Provigil_6_Mth_Unit_Decile = 41
Const cPT_Amrix_Rep_Rank = 44
'' Column Location for Target Overlp TAB
Const cTO_Territory = 1
Const cTO_SaleRepFullName = 2
Const cTO_ME_# = 3
Const cTO_PDRP_Flag = 10
'***** column Location for Trend Tab
Const cTR_Territory = 1
Const cTR_FullName = 2
Const cTR_ME_Num = 3
Const cTR_DEA_Num = 4
Const cTR_Last_Name = 5
Const cTR_First_Name = 6
Const cTR_PDRP_Flag = 7
Const cTR_Amrix_Report_Group = 8
Const cTR_Address = 9
Const cTR_City = 10
Const cTR_State_Abbrev = 11
Const cTR_ZIP_Code = 12
Const cTR_Amrix_Trx_CNT_CURR_YTD = 13
Const cTR_CNS_Detls_YTD = 14
Const cTR_Amrix = 15
Const cTR_CNS_Detls_3 = 16
Const cTR_Rx_Per_Call = 17
Const cTR_Amrix_Trx_CNT_SEM01 = 18
Const cTR_Amrix_Trx_QTY_SEM01 = 19
Const cTR_Amrix_Trx_Cnt_12 = 20
Const cTR_Amrix_Trx_Cnt_11 = 21
Const cTR_Amrix_Trx_Cnt_10 = 22
Const cTR_Amrix_Trx_Cnt_09 = 23
Const cTR_Amrix_Trx_Cnt_08 = 24
Const cTR_Amrix_Trx_Cnt_07 = 25
Const cTR_Amrix_Trx_Cnt_06 = 26
Const cTR_Amrix_Trx_Cnt_05 = 27
Const cTR_Amrix_Trx_Cnt_04 = 28
Const cTR_Amrix_Trx_Cnt_03 = 29
Const cTR_Amrix_Trx_Cnt_02 = 30
Const cTR_Amrix_Trx_Cnt_01 = 31
Const cTR_Amrix_Trx_CNT_Cal_QTR04 = 32
Const cTR_Amrix_Trx_CNT_Cal_QTR03 = 33
Const cTR_Amrix_Trx_CNT_Cal_QTR02 = 34
Const cTR_Amrix_Trx_CNT_Cal_QTR01 = 35
Const cTR_Amrix_Trx_CNT_YR01 = 36
'' Column Location for PAYER TAB
Const cPY_Territory = 1
Const cPY_SaleRepFullName = 2
Const cPY_ME_# = 3
Const cPY_PDRP_Flag = 8
Const cPY_Amrix_Spec_Grp = 9
Const cPY_CNS_Calls_YTD = 15
Const cPY_Flexeril_6_Mth_TRx = 18
Const cPY_Amrix_Oct07_TRx = 19
Const cPY_Amrix_Dec07_TRx = 21
Const cPY_Amrix_6_Mth_TRx = 22
Const cPY_Amrix_6_Mth_Unit_Decile = 23
Const cPY_MR_Market_6_Mth_TRx = 30
Const cPY_Provigil_6_Mth_TRx = 32
Const cPY_Provigil_6_Mth_Unit_Decile = 33
Dim bRealigned As Boolean
'' Column Location for Target Overlap Report
sShellFile = sDefaultPath & "TEMPLATE\" & sABMTemplateFile
bRealigned = IIf(InStr(sReportName, "Realigned") > 0, True, False)
dtEnd = DateSerial(iYear1, iMonth, 1)
'''''''''''''''''''''''''''''''
''' Select the Geography that will drive the process
''' based on the Organization Level.
'''''''''''''''''''''''''''''''
Select Case Level
Case EL_REGION
sLevel = "Region"
sSql = "select distinct Region FROM [Region Reports]"
Case EL_AREA
sLevel = "Area"
sSql = "select distinct left([Area],4) FROM [Area Reports]"
Case EL_TERRITORY
sLevel = "Territory"
sSql = "select Territory FROM [Territory Reports] order by
Territory"
Case EL_NATION
sLevel = "Top 300"
sSql = "select '2' " 'Dummy SQL to prevent interruption
of flow
Case Else
' should never get here
MsgBox "Unable to process selected level: " & Level
Stop
End Select
rsGeography.Open sSql, cnn, adOpenStatic, adLockReadOnly
Set xl = New Excel.Application
Do While Not rsGeography.EOF
sGeography = rsGeography.Fields(0).Value
Debug.Print "sGeography = " & sGeography
' startingStep sGeography, "Spreadsheet", "AmrixPrescriberTargeting"
setReportStatusBar "Creating ""Amrix Prescriber Targeting"" report
for " & sLevel & " " & sGeography
rsCheck.Open "select count(1) from [Target Amrix Demographic] where
territory_num like '" & _
sGeography & "%'", cnn, adOpenStatic, adLockReadOnly
iRecords = rsCheck.Fields(0)
rsCheck.Close
If iRecords = 0 Then
Debug.Print "Skipping " & sGeography & " due to a lack of
records (probably realigned)"
Else
xl.Workbooks.Open sShellFile
Set wkb = xl.ActiveWorkbook
setWorkbookComments wkb, sGeography
If sLevel = "Top 300" Then
sGeography = "Top 300"
End If
sFileName = sDefaultPath & "Field\PrescTarg\Amrix\" & sGeography
& ".xls"
wkb.SaveAs sFileName
'''''''''''''''''''''''''''''''
''' Amrix Targeting Worksheet
'''''''''''''''''''''''''''''''
Set wks = wkb.Worksheets("Amrix Targeting")
With wks
.Name = sGeography & " " & .Name
.Activate
' KMB 2008-01-15 Added 3 month trend
setMonthColumnHeadings wks, cPT_Amrix_Dec07_TRx, dtEnd, 3,
1, "Amrix", "TRx"
hideMonthColumnsBeforeLaunch wks, cPT_Amrix_Dec07_TRx,
dtEnd, #11/1/2007#, 3, 1
If sLevel <> "Top 300" Then
setupQueryParameter cmdData,
"qrySelAmrixTargetingReport", "TERR", sGeography & "%"
Else
setupQueryParameter cmdData,
"qrySelAmrixTargetingReportTop300", "TERR", sGeography & "%"
End If
Set rsData = cmdData.Execute
.Range("A2").CopyFromRecordset rsData
rsData.Close
iLastRow = xl_LastRow(wks)
iLastCol = xl_LastCol(wks)
overwritePDRP wks, iLastRow, _
cPT_PDRP_Flag, _
cPT_Amrix_Oct07_TRx, _
cPT_MR_Market_6_Mth_TRx
overwritePDRP wks, iLastRow, _
cPT_PDRP_Flag, _
cPT_Provigil_6_Mth_TRx, _
cPT_Provigil_6_Mth_Unit_Decile
overwriteSurgeons wks, iLastRow, _
cPT_Amrix_Spec_Grp, _
cPT_Provigil_6_Mth_TRx, _
cPT_Provigil_6_Mth_Unit_Decile
totalAndCount wks, 1, iLastRow, _
cPT_CNS_Calls_YTD, _
cPT_Provigil_6_Mth_TRx
' blank out total rows for decile columns
For i = cPT_Amrix_6_Mth_Unit_Decile To
cPT_Provigil_6_Mth_Unit_Decile Step 2
.Cells(iLastRow + 2, i) = ""
Next i
' blank out sum of the Ratio. Sum of ratio does not make
sense in this case.
.Cells(iLastRow + 2, cPT_Amrix_3Mth_Ratio) = ""
.Cells(iLastRow + 3, cPT_Amrix_3Mth_Ratio) = ""
.Columns(cPT_ME_#).EntireColumn.Hidden = True
If Level = EL_TERRITORY Then
.Columns(cPT_Territory).EntireColumn.Hidden = True
.Columns(cPY_SaleRepFullName).EntireColumn.Hidden = True
End If
xl.Run "Casino_Slots"
.Range("c1").Select
scrollToUpperLeft wks
.PageSetup.CenterFooter = "Current Data Month = " & sMonth1
& " " & iYear1
End With
'''''''''''''''''''''''''''''''
''' Target Overlap Worksheet. New TAB 02Feb08.
''' Shows a consolidated view of target overlap for PCS and
inVentiv
'''''''''''''''''''''''''''''''
Set wks = wkb.Worksheets("PCS-inVentiv Targets")
With wks
.Name = sGeography & " " & .Name
.Activate
If sLevel <> "Top 300" Then
setupQueryParameter cmdData,
"qrySelAmrixTargetingOverlapReport", "TERR", sGeography & "%"
Else
setupQueryParameter cmdData,
"qrySelAmrixTargetingOverlapReportTop300", "TERR", sGeography & "%"
End If
Set rsData = cmdData.Execute
If rsData.EOF And rsData.BOF Then
' TODO: put out a message saying there is no overlap
Else
rsData.MoveFirst
.Range("A2").CopyFromRecordset rsData
rsData.Close
End If
.Columns(cTO_ME_#).EntireColumn.Hidden = True
If Level = EL_TERRITORY Then
.Columns(cTO_Territory).EntireColumn.Hidden = True
.Columns(cPY_SaleRepFullName).EntireColumn.Hidden = True
End If
.Range("c1").Select
scrollToUpperLeft wks
.PageSetup.CenterFooter = "Current Data Month = " & sMonth1
& " " & iYear1
End With
'''''''''''''''''''''''''''''''
''' Payer Worksheet. New TAB 02Feb08.
''' Shows each Payer Plan for each ME.
'''''''''''''''''''''''''''''''
Set wks = wkb.Worksheets("Payer")
If Level = EL_AREA Or Level = EL_TERRITORY Or Level = EL_NATION
Then
With wks
.Activate
If sLevel <> "Top 300" Then
setupQueryParameter cmdData,
"qrySelAmrixTargetingPayerReport", "TERR", sGeography & "%"
Else
setupQueryParameter cmdData,
"qrySelAmrixTargetingPayerReportTop300", "TERR", sGeography & "%"
End If
Set rsData = cmdData.Execute
rsData.MoveFirst
.Range("A2").CopyFromRecordset rsData
rsData.Close
iLastRow = xl_LastRow(wks)
iLastCol = xl_LastCol(wks)
overwritePDRP wks, iLastRow, _
cPY_PDRP_Flag, _
cPY_Flexeril_6_Mth_TRx, _
cPY_Flexeril_6_Mth_TRx
.Columns(cPY_ME_#).EntireColumn.Hidden = True
If Level = EL_TERRITORY Then
.Columns(cPY_Territory).EntireColumn.Hidden = True
.Columns(cPY_SaleRepFullName).EntireColumn.Hidden =
True
End If
wkb.Worksheets(1).Activate
xl.Run "AutoComment"
wkb.Worksheets(2).Activate
xl.Run "AutoComment"
wkb.Worksheets("Payer").Activate
.Range("c1").Select
scrollToUpperLeft wks
.Name = sGeography & " " & .Name
End With
Else
wks.Visible = xlSheetHidden
End If '''' If Level = EL_AREA Or Level = EL_TERRITORY Then
Set wks = wkb.Worksheets("Specialty Code Description")
With wks
.Activate
rsData.Open "qrySelSpecialtyCodeListPT", cnn, adOpenStatic,
adLockReadOnly
.Range("A2").CopyFromRecordset rsData
rsData.Close
.Range("c1").Select
scrollToUpperLeft wks
End With
'**********Insert Amrix 12 Month Trend Tab
'********** TJ 09-22-2008 ********************
Set wks = wkb.Worksheets("Amrix 12 Mth TRx Count Trend")
With wks
.Name = sGeography & " Amrix 12 Mth TRx"
.Activate
'setMonthColumnHeadings wks, 34, dtEnd, 12, 1
'.Range("AI1") = sPreBaseQtr
'.Range("AJ1") = sBaseQtr
'.Range("AK1") = sPriorQtr
'.Range("AL1") = sCurrentQtr
If sLevel <> "Top 300" Then
setupQueryParameter cmdData,
"qrySelAmrixTrendTrxReport", "TERR", sGeography & "%"
Else
setupQueryParameter cmdData,
"qrySelAmrixTrendTrxReportTop300", "TERR", sGeography & "%"
End If
Set rsData = cmdData.Execute
rsData.MoveFirst
.Range("A2").CopyFromRecordset rsData
rsData.Close
iLastRow = xl_LastRow(wks)
iLastCol = xl_LastCol(wks)
totalAndCount wks, 1, iLastRow, 13, 18
totalAndCount wks, 1, iLastRow, 22, iLastCol - 2
.Cells(iLastRow + 2, 17) = "" ' blank out total for Rx Per
Call
.Columns(3).EntireColumn.Hidden = False
.Columns(19).EntireColumn.Hidden = True ' hide Takeda CSP
until we get data
If Level = EL_TERRITORY Then
.Columns(cTR_Territory).EntireColumn.Hidden = True
.Columns(cTR_FullName).EntireColumn.Hidden = True
End If
.Range("c1").Select
scrollToUpperLeft wks
.PageSetup.CenterFooter = "Current Data Month = " & sMonth1
& " " & iYear1
End With
'***End 12 month Trend Tab
wkb.Worksheets(sGeography & " Amrix Targeting").Activate
wkb.Save
wkb.Close
End If '''' If iRecords = 0 Then
rsGeography.MoveNext
Loop
setReportStatusBar ""
END_OF_TARGET:
xl.Quit
End Sub