Option Explicit
Public Const calcOuputFilePath = "S:\Monthly Incentive Calculator" ' calculator location
Public Const strTemplate = "Monthly Incentive Calculator Template.xls" ' template location
Public Const psrEMPLIDIndex = 1
Sub generateReports()
Dim i As Integer
Dim tbl As Range
Dim wkbkGen As Workbook, wkbkTemp As Workbook
Dim templateBusUnitSht As Worksheet
Dim strLevel As String, pathStr As String, mktLeaderName As String, strReportLevel As String
Dim psrEMPLID As String, psrFirstNameStr As String, psrLastNameStr As String
Dim psrStatusStr As String, psrNTIDStr As String, psrStateStr As String
Dim currMthStr As String, fileNamePrefix As String, currMthNumDays As Integer
Dim qtrMth1 As String, qtrMth2 As String, qtrMth3 As String
Dim rownum As Integer, fileCount As Integer
Dim reportName As String, folderPathStr As String
Dim prctProgress As Single
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set wkbkGen = ThisWorkbook 'this is the generator workbook
pathStr = ThisWorkbook.Path 'this is the path where the generator is located
fileCount = Range("count_level") 'the number of PSR files to generate
On Error Resume Next
Kill pathStr & "\Reports" & "\*.xls"
On Error GoTo 0
Sheet1.Select ' select control sheet on generator
'below if statement sets the range for non-existing PSR NTID folder
If Range("CELL_PSR_FOLDER_START") <> "" Then
Set tbl = Range("CELL_PSR_FOLDER_START").CurrentRegion
tbl.Offset(2, 0).Resize(tbl.Rows.Count - 2, tbl.Columns.Count).ClearContents
End If
ProgressBox.Show 'displays progress bar
'below if statement starts the process of generating the PSR files
For i = 1 To fileCount
'this displays the status in percentage value in the progress bar of the PSR file being generated and the name of file
'being generated
Application.StatusBar = "Generating " & psrNTIDStr & " Report....." & i & " of " & fileCount
prctProgress = i / fileCount * 100
ProgressBox.Increment prctProgress, "Creating report for " & psrNTIDStr & "- " & i & " out of " & fileCount
'sets the ranges to copy in the PSR Roster file
psrEMPLID = Range("CELL_PSR_ROSTER_START").Offset(i, 0)
psrFirstNameStr = Range("CELL_PSR_ROSTER_START").Offset(i, 2)
psrLastNameStr = Range("CELL_PSR_ROSTER_START").Offset(i, 3)
psrStatusStr = Range("CELL_PSR_ROSTER_START").Offset(i, 4)
psrStateStr = Range("CELL_PSR_ROSTER_START").Offset(i, 5)
psrNTIDStr = Range("CELL_PSR_ROSTER_START").Offset(i, 6)
'below if statement only selects PSR positions that are filled
If UCase(psrStatusStr) = "FILLED" Then
currMthStr = Range("CELL_CURR_MTH")
currMthNumDays = Range("CELL_CURR_MTH_DAYS")
'this sets the prefix of the PSR file name
fileNamePrefix = Range("CELL_FILE_PREFIX")
'this is the report name being created which includes the file prefix, current month,
'PSR first and last name
reportName = fileNamePrefix & " - " & currMthStr & " - " & psrFirstNameStr & " " & psrLastNameStr & ".xls"
'this opens the template workbook by finding the path and the name of the template
Workbooks.Open ThisWorkbook.Path & "\template\" & strTemplate
'this sets the template as the active workbook
Set wkbkTemp = ActiveWorkbook
'this sets the range to copy the PSR data unto the template
With Sheets("control")
.Range("CELL_PSR_NAME") = psrFirstNameStr & " " & psrLastNameStr
.Range("CELL_PSR_STATE") = psrStateStr
.Range("CELL_CURR_MTH") = currMthStr
.Range("MTH_NUM_DAYS") = currMthNumDays
End With
'============================================================================
'activate generator
wkbkGen.Activate
'select PSR Rev Target sheet
Sheet3.Select
'filter the sheet
If ActiveSheet.AutoFilterMode = False Then
Selection.AutoFilter
End If
'select the range and autofilter based on employee id
ActiveSheet.Range("DATA_PSR_REVTGT").AutoFilter Field:=psrEMPLIDIndex, Criteria1:=psrEMPLID
Set tbl = Range("a1").CurrentRegion
tbl.Offset(1, 0).Resize(tbl.Rows.Count - 1, tbl.Columns.Count).Select
Selection.Copy
'activate template
wkbkTemp.Activate
'paste the selected PSR ID, PSR Name, DSM ID and DSM Name and Payer Type Revenue
ActiveWorkbook.Sheets(1).Range("CELL_TGT_START").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'after pasting move the cursor to cell a1
Range("a1").Select
'this saves the workbook in the report folder with the report name to include prefix, PSR name
'and current month
ActiveWorkbook.SaveAs pathStr & "\Reports\" & reportName
'this also saves a copy of the file in the Monthly Incentive Calculator folder in S: drive
'in the appropriate NTID folder of the PSR, so the PSRs can access it
folderPathStr = calcOuputFilePath & "\" & psrNTIDStr
On Error Resume Next
Kill folderPathStr & "\*.xls"
On Error GoTo 0
'this if statements checks to see if there is a NTID folder for the PSR and if
'not then put the name of the PSR who doesn't have a folder
If Dir(folderPathStr, vbDirectory) = "" Then
With wkbkGen.Sheets(1)
.Range("CELL_PSR_FOLDER_START").Offset(.Range("CELL_PSR_FOLDER_COUNT"), 0) = psrNTIDStr & "_" & psrFirstNameStr & "_" & psrLastNameStr
End With
Else
ActiveWorkbook.SaveAs folderPathStr & "\" & reportName
End If
ActiveWorkbook.Close , False
End If
Next i
Application.StatusBar = False
Sheets("control").Select
ProgressBox.Hide
MsgBox "Reports have been generated succussfully!", vbInformation
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
