Home

User Manual for Personnel Inventory Aging and Promotion Model

1. temp yos SOL DELETE temp target FROM temp WHERE temp target Is Null End Sub Private Function ENs Need As Long pg As Integer yr As Byte rule As Byte Dim lngProms As Long strRule 3 As String Benchmarks As Variant strRule 1 ASC strRule 3 DESC Benchmarks Split 00 0 2 2 4 4 9 14 8 18 5 22 2 For lngProms 0 To 8 Benchmarks lngProms Benchmarks lngProms 12 Next v 45 46 lngProms 0 Set rs Nothing If rule 2 Then SQL SELECT Yr 6 yr amp ssn Yr amp yr amp pg Yr amp yr 6 s Yr amp yr 6 months Yr amp yr amp yig Yr _ yr yos Yr yr mos pg AttrRates prob se amp 0 AS prom mnths amp lngTarget pg amp AS target amp yr amp months 12 amp Benchmarks pg amp AS bm amp INTO temp FROM Yr amp yr amp INNER JOIN AttrRates amp ON Yr amp yr amp yos AttrRates yos amp AND Yr amp yr amp rate AttrRates rate amp AND Yr amp yr pg AttrRates pg _ amp WHERE Yr yr amp rate amp strOcc amp _ amp AND Yr 6 yr amp pg pg amp amp ORDER BY ABS Yr amp yr months 12 6 Benchmarks pg amp amp s amp yr amp ssn Change attrition rates SQL UPDATE temp SET t
2. CopyAllSheets Set ws_l ActiveWorkbook Sheets Likelihood Data FixLikChart yrs FilterLikely F XTTSOhart FixAxis yrs RefreshPivot Sep RefreshPivot Shortage Sheets Metadata Select ActiveWorkbook SaveAs strPath amp Results_ amp rate amp _ amp Format Now mmddyy_hhmmss amp xls ActiveWorkbook Close False ws_t Activate FixLikChart yrs FilterLikely FixTISChart FixAxis yrs Sheets Metadata Select Set ws t Nothing Set ws_l Nothing Set wb Nothing End Sub Private Sub TISHeader With Cells 1 1 Value2 rating Offset 0 1 Value2 rule Offset 0 2 Value2 pg Offset 0 3 Value2 yr Offset 0 4 Value2 cnt Offset 0 5 Value2 AvgOfprom mnths End With Private Sub FixGetExpected Workbooks Expected amp rating rule amp xls Activate ActiveWorkbook Sheets EYr amp yr Activate Move data to driver Range A3 F8 Copy ws_t Activate Move to first empty row Cells ELastCell ws t Row 1 1 Select ActiveSheet Paste Application CutCopyMode False End Sub Private Sub FixLikely wb Activate Move column headers to driver Rows 1 1 Select Selection Cut ws l Activate Cells 1 1 Select ActiveSheet Paste wb Activate Selection Delete shift xlUp End Sub Private Sub GetLikely Move data to driver Selection Curre
3. amp yr 1 amp Accessions End Sub lngAccess Private Sub AddSep yr As Byte pg As Integer losses As Long Add to Separation table Dim sep As DAO Recordset Set sep CurrentDb OpenRecordset SepData With sep AddNew Fields rate Value strOcc Fields rule strRule frameRules Fields pg pg Fields yr yr Fields cnt cnt Fields seps losses Fields pct losses cnt Update End With Set sep Nothing cnt As Long 1 ElSep 49 End Sub Private Sub AddProm yr As Byte pg As Integer Add to Separation table Dim sep As DAO Recordset Set sep CurrentDb OpenRecordset Prom With sep AddNew Fields rate Value strOcc Fields rule strRule frameRules Fields pg pg Fields yr yr Fields cnt cnt Fields proms promotions Fields pct promotions cnt Update End With Set sep Nothing End Sub Private Function NewAccess yr As Byte As Long Select Case optPersChange Case 1 1 time change NewAccess lngTarget 3 lngCurrCnt Case 2 Permanent change NewAccess CalcByoptPers 1 Case 3 Constant change NewAccess CalcByoptPers yr 1 End Select If yr 0 Then End If End Function Private Function CalcByoptPers yrnum As Byte Select Case optPers Case 1 By number in occ array CalcByoptPers yrnum sngIntDecPers 0 lngTarget 3 lngCu
4. ETE AttrRates rate FROM AttrRates WHERE AttrRates rate D amp rt2 amp Make rate cons U W DoCmd RunSQL Y amp wun End Sub AND AttrRates pg amp rt2PG amp istant PDATE AttrRates SET AttrRates rate 6 rt _ HERE AttrRates rate amp rt2 amp Function RefreshLinks Dim dbs As Database tdf As TableDef Dim CurPath As String TblName As String CurPath CurrentProject Path Loop through all tables in the database Set dbs CurrentDb For Each tdf In dbs TableDefs If the table has a connect string it s a linked table If Len tdf Connect 0 Then TblName tdf Connect DATABASE CurrentProject Path amp V Err 0 GetTableName tdf Connect amp TblName On Error Resume Next tdf RefreshLink Relink the table Can t find the file so search up the path If Err lt gt 0 Then Do CurPath HigherPath CurPath Err 0 tdf Connect DATABASE CurPath amp W _ amp TblName tdf RefreshLink Loop While Err lt gt 0 And Len CurPath gt 2 End If If Err lt gt 0 And tdf Name Yr0 Then MsgBox Err Description 37 RefreshLinks False End If End If Next tdf End Function Private Function GetTableName OldPath As String As String Get table name from full path amp file name Dim byt
5. Nothing As String Workbook Path _ mixlar e Metadata ls xlLastCell ClearContents Range Cells 1 1 Cell Workbooks OpenText Fil amp N 6 run 6 NMetadata x Range Cells 1 1 Cells 1 2 C1 Cells 2 1 CurrentRegion Select s SpecialCe lename Activ 76 eWorkbook Path _ Ls earContents Header _ Dim c As Range For Each c In Selection c Value2 c Value2 Next Selection Copy ws l Activate Cells 1 1 Select ActiveSheet Paste Application CutCopyMode False Workbooks Metadata xls Close False Range B1 NumberFormat m d yy h mm AM PM Columns A B EntireColumn AutoFit Metadata Cells 3 2 Value2 Cells 1 1 Select End Function Sub CopyAllSheets Sheets Array YOS_PG Chart YOS_PG Pivot YOS_PG Data TISTIG Chart TISTIG Pivot TISTIG Data Prom Chart Prom Pivot Prom Data Shortage Chart Shortage Pivot Shortage Data Sep Chart Sep Pivot Sep Data TLS Chart TIS TIS Pivot TIS Data Likelihood Chart Likelihood Data Metadata Copy End Sub 71 Compile Attribute VB Name Compile Programming by Robert W Shuford CNA Option Explicit Option Base 1 Const DATASHEETS 7 Dim wb As Workbook wbNew As Workbook wbDriver As Workbook Dim bytYrs As Byte Public blnDisableEvents As Boolean Sub CompileAllDat
6. Utilities Sub ResetSeed 39 Sub KillTables Sub KillReportTables Sub SQL Function RefreshLinks Private Function GetTableName Private Function HigherPath Public Sub FeedMeta Sub KillXL Sub MakeRunDirs Function Maximum Sub XportMods Private Sub PrntTrgts Controller form Private Sub cmdIncDec Private Sub cmdKill Private Sub cmdRun Private Sub cmdKillXL Private Sub cmdXport Personnel form Private Sub cmdUse Public Sub AssignPers Manpower form Private Sub cmdUse Public Sub AssignMan Private Sub IbloccO Private Sub Iblocc1 Private Sub Iblocc2 Private Sub Iblocc3 Private Sub Iblocc4 Private Sub CopyAcross 40 Main Attribute VB Name Main Programming by Robert W Shuford CNA Option Compare Database Option Explicit Option Base 0 Global variables Public Const NUMRULES 3 Const E5ADJ 27 Months since 7 1 2005 to 10 1 2007 our current data Pu lic strOcc As String rs As DAO Recordset Public lngTarget 9 As Long lngOccCount As Long strOccArray As String b b Public lngAllOccsPers As Long occ As Byte lngCurrCnt As Long Dim strRule NUMRULES As String bytWarnLevel As Byte lngAccess As Long AccumulatedShortage As Long For Manpower form Public frameRules As Byte optManChange As Byte min tig 8 As Integer min tis 8 As Integer Public sngIntDec 8 6 As Single optType As Byte sngLossChange 9 As Single Public bytStopYr 9
7. Next Case 3 4 FeedMeta Personnel Change sngPers End Select Add info from Manpower Select Case optManChange Case 1 str l time change Case 2 str Permanent change Case 3 str Constant change End Select FeedMeta Manpower Change Type str Select Case optType Case 1 str Percentage Case 2 str Number End Select FeedMeta Manpower Change Number Type str For i 0 To 8 For j 3 To 9 If sngIntDec i j 3 lt gt 0 Then FeedMeta _ 4 CE 6 j Change Next Next End Sub sngIntDec i j 3 Get number in each grade to be used as a target in each year Sub GetTargets Dim i As Byte Create temp table with the number in SQL SELECT Yr0 pg Count Yr0 pg AS cnt amp INTO temp FROM YrO amp GROUP BY Yr0 pg YrO rate amp HAVING YrO0 rate amp strOcc amp amp ORDER BY Yr0 pg Load into lngTarget array Set rs CurrentDb OpenRecordset temp rs MoveFirst For i 3 To 9 lngTarget i rs cnt rs MoveNext Next Set rs Nothing End Sub ach grade to be used as a target in each year Increase or decrease manpower by the values from the Increase Decreas Sub ChangeTargets oc As Byte Optional yr As Byte 0 Byte Dim i As Byte Select Case optType Targets form 55 Case 1 For i By percentage 3 To 9 If yr lt bytStopYr i Then lngTarge
8. 103 104 If ToVBProject Is Nothing Then CopyModule False Exit Function End If If FromVBProject Protection vbext pp locked Then CopyModule False Exit Function End If If ToVBProject Protection vbext pp locked Then CopyModule False Exit Function End If On Error Resume Next Set VBComp FromVBProject VBComponents ModuleName If Err Number 0 Then CopyModule False Exit Function End If MOMO VO A FName is the name of the temporary file to be used in the Export Import code MOMO A FName Environ Temp amp N ModuleName bas If OverwriteExisting True Then MOMO VO AA M If OverwriteExisting is True Kill the existing temp file and remove the existing VBComponent from the ToVBProject MOMO VO AAA M M If Dir FName vbNormal vbHidden vbSystem lt gt vbNullString Then Err Clear Kill FName If Err Number 0 Then CopyModule False Exit Function End If End If With ToVBProject VBComponents Remove item ModuleName End With Else MOMO VO AAA OverwriteExisting is False If there is already a VBComponent named ModuleName exit with a return code of False MOMO VO AA Err Clear Set VBComp ToVBProject VBComponents ModuleName If Err Number 0 Then If Err Number 9 Then module doesn t exist ignore error Else
9. Copy Before Sheets 1 ActiveSheet Name Count Data Sheets TISTIG Data Copy Before Sheets 2 ActiveSheet Name AveTIS Data Sheets TISTIG Data Name AveTIG Data ShortSepTIS Count D j D G M D VE K E H N lst data column min As Byte base stat std max ShortSepTIS AveTIS D H D F j D KillYs 92 id Sep Data TIS Data Likelihood Data Copy ShortSepTIS AveTIG D i E G k D KIillYr ShortSepTIS YOS PG E Gy E F H D ShortSepTIS Prom D L F i o D ShortSepTIS Shortage D Ly F i o D E M G Pj p E ShortSepTIS Sep D L F i o D VE M G j p E ShortSepTIS TIS D i E G k D VE j F H L E KillYxr MakeCharts CopyModule Robust ThisWorkbook VBProject ActiveWorkbook VBProject True CopyModule Utilities ThisWorkbook VBProject ActiveWorkbook VBProject True CopyModule frmChoice ThisWorkbook VBProject ActiveWorkbook VBProject True AddProcedureToModule AddReference 0002E157 0000 0000 C000 000000000046 ActiveWorkbook SaveAs strPath amp NSensitivity Data for amp Mid strFN 10 ActiveWorkbook Close False Application ScreenUpdating True End Sub Private Sub ShortSepTIS dat As String col As Byte min As Byte base As Byte std As Byte max As Byte id As Byte Dim stat As Variant bytcols As Byte Sheets dat amp Data
10. Create AllYrs table Public Sub CompileData MaxYear As Byte Dim qdf As QueryDef i As Byte lst year With CurrentDb Set qdf CreateQueryDef b1 SELECT 1 AS yr Yrl pg Yrl rate amp Avg Yrl target AS target Count Yrl pg AS cnt amp FROM Yrl GROUP BY 1 Yrl pg Yrl rate _ E Set qdf CreateQueryDef b2 SELECT Yrl pg Avg Yrl prom mnths amp AS prom mnths ave FROM Yrl GROUP BY Yrl pg SQL SELECT bl b2 prom mnths ave INTO AllYrs amp FROM bl INNER JOIN b2 ON bl pg b2 pg End With DoCmd DeleteObject acQuery b1 DoCmd DeleteObject acQuery b2 Append other years For i 2 To MaxYear With CurrentDb Set qdf CreateQueryDef bl SELECT amp i amp AS yr Yr s i _ amp rate 6 Yr 6 i pg Avg Yr i _ amp target AS target _ amp Count Yr amp i pg AS cnt FROM Yr amp i _ amp GROUP BY 6 i 6 Yr amp i pg Yr amp i amp rate _ E Set qdf CreateQueryDef b2 SELECT Yr amp i amp pg Avg Yr amp i _ amp prom mnths AS prom mnths ave FROM Yr amp i amp GROUP BY Yr 6 i amp pg SQL INSERT INTO AllYrs prom mnths ave SELECT bl b2 prom mnths ave amp FROM bl INNER JOIN b2 ON bl pg b2 pg End With DoCmd DeleteObject acQuery b1 DoCmd DeleteObject
11. End Sub Private Sub NewField fld As String pos As Byte With ActiveSheet PivotTables PivotTablel With PivotFields fld 83 Private Sub LikFieldSets yrs As Byte Dim i As Byte bytStrt As Byte bytFldNum As Byte Orientation xlDataField Position pos End With End With End Sub Private Sub FieldSets bytDatCol As Byte ParamArray fields As Variant Dim i As Byte bytStrt As Byte bytFldNum As Byte xl As Variant bytStrt 1 bytFldNum 1 For Each xl In Array xlAverage xlStDev xlMin xlMax For i LBound fields To UBound fields NewField CStr fields i bytFldNum bytFldNum bytFldNum 1 Next For i bytStrt To bytFldNum 1 With ActiveSheet PivotTables PivotTablel PivotFields Cells i 3 bytDatCol Value2 Function xl End With Next bytStrt bytFldNum Next End Sub xl As Variant NewField cnt 1 bytStrt 1 bytFldNum 2 For Each xl In Array xlAverage xlStDev xlMin xlMax For i 1 To yrs NewField Yr amp i bytFldNum bytFldNum bytFldNum 1 Next For i bytStrt To bytFldNum 1 With ActiveSheet PivotTables PivotTablel PivotFields Cells i 3 4 Value2 Function xl End With Next bytStrt bytFldNum Next End Sub Private Sub CleanPivot str As String Selection CurrentRegion Select 84 col As Byte Sheets Add ActiveSheet Name str Sheets str Pi
12. Figure 2 YrO database window BER an Boeson Sie X 2n gt MakeRealYrO Run ist Queries A Make Run after MakeRealYrO 4j Forms Reports di Pages a Macros Modules In addition this database contains three macros accessible from the Database Window AutoExec MakeRealYr0 and MakeYr0 Auto Exec automatically executes when the database opens and refreshes the link to SourceData mdb as long as the file is somewhere in the model s file path MakeRealYr0 cleans the source data by deleting records with invalid paygrades by converting the paygrades to a numeric field if necessary and by creating a new table named Rea IYr0 This macro need only be run when SourceData mdb has been updated with new data The programming code for these macros and all supporting functions and subroutines can be found in ap pendix A 3 The weighting formula for attrition rates is 5 2007 Rate 4 2006 Rate 3 2005 Rate 2 2004 Rate 2003 Rate 4 15 The 1 July 2005 change and Grandfather Clause to High Year Tenure for Navy E5s is handled programmatically Make Yr0 The MakeYr0 macro is used to create the rating specific data that will be accessed by the PIAP model On activation this macro l Asks the user to input a two or three character rating if a three character rating is entered it is assumed that it is a compressed rating 3 that becomes a rating denoted by the first two characters at high
13. Select Sheets Add ActiveSheet Name dat Chart Sheets dat amp Data Select bytcols ELastCell ActiveSheet Column For Each stat In Array min base std max Columns stat Select Selection Copy Columns stat bytcols Select ActiveSheet Paste Next Min Columns min bytcols Select Selection Copy Columns col Select ActiveSheet Paste base stat Columns base bytcols Select Selection Copy Columns col 2 Select ActiveSheet Paste End 94 Max Columns max bytcols Select Selection Copy Columns col 4 Select ActiveSheet Paste 2 Cells 2 col 1 Select With ActiveCell FormulaR1C1 RC base bytcols 6 1 RC amp std bytcols Copy Range ActiveCell Cells ELastCell ActiveSheet Row Column Select ActiveSheet Paste Selection Copy Selection PasteSpecial Paste xlValues Operation xlNone SkipBlanks False Transpose False End With 2 Cells 2 col 3 Select With ActiveCell Formula RC 6 base bytcols RC amp std bytcols Copy Range ActiveCell Cells ELastCell ActiveSheet Row Column Select ActiveSheet Paste Selection Copy Selection PasteSpecial Paste xlValues Operation x1None SkipBlanks False Transpose False End With Cells 1 col Value2 Min Cells 1 col 1 Value2 1 STD Cells 1 col 3 Valu
14. strName WhichData strName Case AveTIS AveTIG Count Shortage Sep cbo Case TIS cbo Case Prom cbo cbo Rank List Array E3 EA NRB MEG SEE ES E9 Rank List Array E4 SES E6 NEM ES E9 Rank ist Array E3 NRA WES WEG NE 7 MES sc d d d d d 3 Case Likelihood Rank List Array E3 E4 SES E6 SE E8 lblYOS Visible True txtYOS Visible True spnYOS Visible True End Select Sub Private Sub cmdChart Click Dim strName As String Application ScreenUpdating False If chkDeleteCharts True Then KillCharts strName WhichData If strName Likelihood Then LikChart CByte Right cboRank Value 1 spnYOS Value Else MakeChart strName CByte Right cboRank Value 1 End If Application ScreenUpdating True End Sub Private Sub spnYOS_Change txtYOS Value spnYOS Value End Sub Private Sub txtYOS Exit ByVal Cancel As MSForms ReturnBoolean spnYOS Value txtYOS Value End Sub Private Function WhichData As String Dim strName As String lngSpace As Long strName ActiveSheet Name lngSpace InStr strName WhichData Mid strName 1 lngSpace 1 End Function 109 Workbook VERSION 1 0 CLASS BEGIN MultiUse 1 True END Attribute VB Name ThisWorkbook Attribute VB Glo
15. 23 24 25 27 28 12 Gas Turbine System Technician Electrical 20 Figure 10 Time in Service Time in Grade Figure 10 shows the average Time in Service and Time in Grade for GSEs year by year in each paygrade and for each promotion rule Paygrade and year are along the x axis and the dropdown boxes provide a way to examine the data in more detail by deselecting val ues in any field For example the user can uncheck the 3 4 8 and 9 boxes to see just E5 E7 The Prom Chart in figure 11 shows the percentage of each paygrade that promotes in each year under each promotion rule The nu merators in these percentages are the number of individuals in each paygrade that promoted in that year and the denominator includes the number in that paygrade at the beginning of the year plus the accessions to E3 Thus the individuals not promoting include sepa rations A comparison with figure 13 the Separation chart gives an indication of what percentage in each paygrade and year failed to promote either through lack of need or by not being eligible due to Time in Service or Time in Grade requirements 2 KEZZEZE Figure 11 Prom chart 22 Figure 12 the Shortage chart tells us that the PIAP model predicts we will have a shortage of 42 E6 GSEs in the fourth year under the Junior Rule This is a 17 4 percent gap between personnel and re quirements and it indicates a significant problem will occur in th
16. 6 proms Cells 1 7 pct i i 1 80 End Sub Sheets i Select ActiveSheet Name Shortage Data CommonData Cells 1 6 target Cells 1 7 shortage i i 1 Sheets i Select ActiveSheet Name Sep Data CommonData Cells 1 6 seps Cells 1 7 pct i i ctl1 Sheets i Select ActiveSheet Name TIS Data CommonData Cells 1 6 AvgOfprom mnths i ic ctl1 Sheets i Select ActiveSheet Name Likelihood Data CommonData i i 1 For i 6 To bytLikCols 1 Cells i 1 Yr amp I 5 Next bytYrs bytLikCols 6 Cells 1 bytLikCols likelihood Private Sub CommonData Cells 1 1 rating Cells 1 2 rule Cells 1 3 pg Cells 1 4 yr Cells 1 5 cnt End Sub Private Sub CopyData str As String wbNew Activate Worksheets str 6 Data Select Cells ELastCell ActiveSheet Row 1 1 Select 8l 82 wb Activate Worksheets str amp Data Select Selection AutoFilter Range Cells 2 1 ELastCell ActiveSheet Copy wbNew Activate ActiveSheet Paste Sub MakePivot str As String Dim i As Byte bytBadCol As Byte Worksheets str amp Data Select Cells 1 1 Select Selection CurrentRegion Select ActiveWorkbook PivotCaches Add SourceType xlDatabase SourceData Selection Address CreatePivotTable TableDest
17. Border LineStyle xlNone With Selection End End Sub Private Dim For Next End Sub Selection MarkerS PlotOrder orde With Sub KillYrO0 i As Long i 2 To ELastCel tyle xlNone r If Cells i 3 Va Rows 1 Entir Selection Del End If ActiveSheet Row lue2 0 Then eRow Select ete shift x1Up 99 Utilities Attribute VB Name Utilities Programming by Robert W Shuford CNA Option Explicit Option Private Module Public Function ELastCell TheSheet As Worksheet As Range Returns a single cell range object that represents the intersection of the last non empty row and the last non empty column Dim ExcelLastCell As Range Dim Row As Long col As Integer Dim LastRowWithData As Long LastColWithData As Integer M v ExcelLastCell is what Excel thinks is the last cell Set ExcelLastCell TheSheet Cells SpecialCells xlLastCell Determine the last row with data in it LastRowWithData ExcelLastCell Row Row ExcelLastCell Row Do While Application CountA TheSheet Rows Row 0 And Row lt gt 1 Row Row 1 Loop LastRowWithData Row Determine the last column with data in it astColWithData ExcelLastCell Column col ExcelLastCell Column Do While Application CountA TheSheet Columns col 0 And col lt gt 1 col col 1 Loop astCo
18. SELECT SourceData ssn CInt Right Trim grade 1 AS pg DoCmd RunSQL DELETE Yr0 drop FROM Yr0 WHERE Yr0 drop 1 amp SourceData rate SourceData yos SourceData yig SourceData mos AS months amp SourceData mig AS mos pg INTO RealYr0 FROM SourceData DoCmd RunSQL DELETE RealYr0 yos FROM RealYr0 WHERE RealYr0 pg 0 DoCmd SetWarnings True End Function Private Sub GetPGRateCount Create temp table with the number in each PG DoCmd RunSQL SELECT Yr0 pg Count Yr0 months AS cnt INTO PGRollup 6 FROM Yr0 GROUP BY Yr0 pg ORDER BY Yr0 pg Create temp table with the number in rating DoCmd RunSQL SELECT Yr0 rate Count Yr0 months AS cnt INTO RateRollup amp FROM Yr0 GROUP BY Yr0 rate ORDER BY YrO rate End Sub Dim rt2 rt2 Left rt 2 Select compressed amp uncompressed Private Sub Attrition rt As String rtPG As Byte rt2PG As Byte DoCmd RunSQL SELECT INTO AttrRates FROM RealAttrRates WHERE 36 amp Rea amp rt2 amp Delete high PG lAttrRates rate 6 rt 6 OR RealAttrRates rate WWMy for uncompressed h amp rt amp Delete low PG DoCmd RunSQL DoCmd RunSQL DE ETE AttrRates rate FROM AttrRates WHERE AttrRates rate wany AND AttrRates pg gt W amp rtPG amp NI 77 for compressed D
19. Text Psuedo SSN for tracking individuals year by year rate Text The two or three character rating grade Text Paygrade mos Integer Months of service OS ears of service mig Integer Months in grade yig Integer Years in grade Note that the model only uses paygrades E3 to E9 and that all Els and E2s have been promoted to E3 We believe this to be valid since promotion to E3 is virtually automatic after 1 year of service 1 and the model utilizes actual Time in Service and Time in Grade for promotions and separations Since the model only han dles the enlisted community the grade field is of the form E03 E04 etc but the actual format is irrelevant it may be either numeric or text as long the numeric part of the paygrade Oe 3 4 etc is in the farthest right hand position Yr0 mdb The purpose of the Yr0 mdb database is to clean the source data and prepare it for the PIAP model It contains a link to the SourceData table in SourceData mdb and it also has one physical table named RealAttrRates with the following structure Table 2 RealAttrRates Fields Field rate ps yos prob sep Double Probability of separation in the next year Type Description Text The two or three character rating Byte Paygrade Integer Years of service The attrition rates in this table are based on a 5 year weighted aver age in the DMDC data through fiscal year 2007 with adherence to the Navy s High Year Tenure rules 2
20. i Next End Sub 65 Controller form VERSION 1 0 CLASS BEGIN MultiUse 1 True END Attribute VB_Name Form_Controller Attribute VB Attribute VB_ Attribute VB Attribute VB Programming by Robert W Option Compare Database Option Explicit Private Sub cmdIncDec Click GlobalNameSpac Creatable True PredeclaredId Exposed False Fals True Shuford CNA DoCmd OpenForm Increas End Sub Private Sub cmdKill Click KillTables On Error Resume Next DoCmd DeleteObject acTable DoCmd DeleteObject acTable Decreas Personnel AllYrs Likelihood 4 DoCmd DeleteObject acTable DoCmd DeleteObject acTable DoCmd DeleteObject acTable DoCmd DeleteObject acQuery DoCmd DeleteObject acQuery DoCmd DeleteObject acQuery On Error GoTo 0 DoCmd SetWarnings True End Sub Private Sub cmdRun Click Dim StartTime As Double Dim hr As Byte min As Byte StartTime Timer If IsNull NumYrs 0000 0 0 Or NumYrs Exit Sub End If runs CByte txtRuns MakeRunDirs runs 66 MsgBox Enter Number of Years Expected temp tARates Ni m b2 m tmpOry e As Double runs As Byte i As Byte 1 Then Hold On There acNormal MAS wy acNormal For i 1 To runs Driver i NumYrs Array E7Min E8Min E9Min E7SMin E8SMin E9SMin Next e
21. months AS TIS mos pg AS TIG Y _ 1 6 rate Yr amp bytYr 1 amp pg rule yr pg yos cnt SELECT rule bytYr 1 amp AS yr Yr amp bytYr 1 yos Count Yr cnt Y amp FROM Yr amp bytYr 1 1 6 pg Yr bytYr 18 yos ected tables es promote only separate for speed occ yr amp pg Yr yr amp rate _ amp yr amp yig Yr OS pg AttrRates prob sep arget 9 amp AS target Y INNER JOIN AttrRates _ trRates yos AttrRates rate trRates pg amp strOcc amp wun u u ths prob sep 1 sngLossChange 9 en L Load E9s into new YrX table SQL SELECT temp ssn temp rate temp pg temp months temp yig amp temp mos pg temp prom mnths temp target amp INTO Yr amp yr 1 amp from temp _ amp ORDER BY temp months End Function Private Sub E9Sep yr As Byte Dim losses As Long sep As DAO Recordset losses 0 Set rs CurrentDb OpenRecordset temp Go through each record and either separate or age With rs MoveFirst Do Until EOF Edit Separate If Rnd lt prob_sep Then target Null losses losses 1 Else Age lyos yos 1 lyig yig 1 months months 12 mos pg mos pg 12 End If Update MoveNext Loop End With AddSep yr 1 9 losses rs RecordCount Delete seps
22. tables Dim tdf As TableDef On Error Resume Next For Each tdf In CurrentDb TableDefs If Left tdf Name 2 Yr And tdf Name lt gt Yr0 Then _ DoCmd DeleteObject acTable tdf Name If Left tdf Name 3 EYr Then DoCmd DeleteObject acTable tdf Name If Left tdf Name 1 J Then DoCmd DeleteObject acTable tdf Name If Left tdf Name 1 M Then DoCmd DeleteObject acTable tdf Name If Left tdf Name 1 S Then DoCmd DeleteObject acTable tdf Name Next DoCmd DeleteObject acTable Guys On Error GoTo 0 KillReportTables End Sub Delete individual year tables Sub KillReportTables Dim tdf As TableDef On Error Resume Next For Each tdf In CurrentDb TableDefs If Left tdf Name 4 lt gt MSys Then If Mid tdf Name 5 1 A Then DoCmd DeleteObject acTable tdf Name If Mid tdf Name 5 1 D Then DoCmd DeleteObject acTable tdf Name If Mid tdf Name 5 1 E hen DoCmd DeleteObject acTable tdf Name If Mid tdf Name 5 2 L Then DoCmd DeleteObject acTable tdf Name If Mid tdf Name 1 2 YO Then DoCmd DeleteObject acTable tdf Name End If Next DoCmd DeleteObject acTable Sep DoCmd DeleteObject acTable Shortage 62 End DoCmd DeleteObject acTable Prom DoCmd DeleteObject acTable TISTIG On Error GoTo 0 Sub Shortcut to run SQL Sub M End SQ
23. txt39 Controls Item txt49 0 Then bytStopYr 9 100 69 ry Di ry P ry P 70 Private Sub lblocc0_ Click CopyAcross 0 End Sub Private Sub lbloccl Click CopyAcross 1 End Sub Private Sub lblocc2 Click CopyAcross 2 nd Sub rivate Sub lblocc3 Click CopyAcross 3 nd Sub rivate Sub lblocc4 Click CopyAcross 4 nd Sub rivate Sub CopyAcross rw As Byte Dim i As Byte txtval As String With Controls Item txt amp rw amp 3 SetFocus txtval Text End With For i 4 To 9 With Controls Item txt amp rw amp i SetFocus Text txtval End With Next Controls Item txt amp rw amp 3 SetFocus End Sub Appendix C PIAPM xls programming code Table of contents Main Sub LoopDirs Sub CompileData Private Sub TISHeader Private Sub FixGetExpected Private Sub FixLikely Private Sub GetLikely Public Sub FilterLikely Private Sub GetNewData Private Function Metadata Sub CopyAllSheets Compile Sub CompileAllData Private Sub MakeNewWB Private Sub CommonData Private Sub CopyData Sub MakePivot Sub CommonFields Private Sub NewField Private Sub FieldSets Private Sub LikFieldSets Private Sub CleanPivot Private Sub KillBadRow Private Sub FillCols Private Sub MoveData Private Sub KillLikSeries Formatting Public Sub FixLikChart Public Sub FixTISChart Public Sub FixAxis Private Sub SetSrc Private Sub Blue Hobust S
24. 0 Correctly choosing a Type of Increase Decrease is necessary since this example would increase requirements 1000 percent each year if By Percentage were erroneously checked this would likely cause the database to exceed its maximum size of 2Gb and make it permanently unusable In this example an alternative method of reaching 150 in the fifth year is to calculate the percent age change necessary in each year to reach that goal 150 3 08447 Goo 14 Warning form Enter that number into the first row and choose By Percentage for Type of Increase Decrease In the fifth row the user can vary the overall assumed attrition rates for each paygrade For example if E5 has an overall loss rate of 10 percent entering 2 in the fifth row under E5 will result in an overall attrition rate of 8 percent For ease of entry rows one four and five have buttons to the far left that will copy the values in the E3 column to all columns The sec ond and third rows of the matrix allow variations in Time in Service and Time in Grade minimums in months for promotion to each paygrade Since the consequences of reaching Access maximum file size are so dire permanent file corruption and nonfunctionality we have included programming that monitors the size of the database and warns the user when it reaches 50 percent 75 percent and 90 per cent of the size limit In addition the Warning form projects the size of the database at the e
25. As Byte O For Personnel form 1 time permanent constant change option Public optPersChange As Byte Number or percent to change array is by occ Public sngPers As Single sngIntDecPers 9 As Single Number or percentage by occ option Public optPers As Byte Dim ElSep As Single Sub Driver Run As Byte yrs As Byte MinYIG As Variant Dim i As Byte ruleocc As String Dim varReturn As Variant DoCmd SetWarnings False KillTables MakeTables strOcc 0 lngAllOccsPers GetOccCount strRule 1 JU strRule 2 M strRule 3 S Get form data in case Use buttons not clicked Form_Increase Decrease Personnel AssignPers False Form Increase Decrease Manpower Targets AssignMan MakeMetaTable yrs MinYIG For occ 0 To UBound strOccArray End strOcc ElSep For frameRules MakeGuysTable strOccArray occ GetNewGuySepRate 1 To 3 ResetSeed GetTargets DoYears occ Expected Run yrs frameRules yrs Renam ruleocc For i l DoCmd DoCmd Next DoCmd Rename ru DoCmd Rename ru DoCmd Rename ru tables prepending rule strRule frameRules amp To yrs Rename ruleocc amp Rename ruleocc amp Yr leocc amp AllYrs leocc amp leocc amp Next Next DoCmd Rename Sep acTable For Each varReturn In Array Sep TISTIG YOS PG DoCmd TransferSpreadsheet acExport amp 6 Run
26. B Name Programming by Robert W MakeData Option Compare Database Option Private sngPGCount 8 Explicit Function MakeYrO 34 Dim rating As rating UCas DoCmd SetWarn LowHighPct Select recor String As Single Shuford CNA StrPG e InputBox Enter Rating ings False GetHighPGRatios rating ds on rate DoCmd RunSQL SELECT RealYr0 ssn RealYr0 pg _ s RealYr0 rate RealYr0 yos RealYrO yig s RealYr0 months RealYr0 mos pg 0 AS drop INTO YrO0 FROM RealYrO _ amp WHERE RealYr0 rate amp rating OR RealYr0 rate amp Left rating 2 amp Change Els amp E2s to E3 DoCmd RunSQL UPDATE Yr0 SET Yr0 pg 3 WHERE Yr0 pg lt 3 Drop bad records DoCmd RunSQL DELETE Yr0 pgl YrO rate _ s YrO yos YrO vig Yr0 months Yr0 mos pg amp FROM Yr0 WHERE YrO pg Is Null Or Yr0 ratel s Or Yr0 yos Is Null Or Yr0 months Is Null _ s Or Yr0 mos poli Is Null Drop if TIG gt TIS DoCmd RunSQL DELETE Yr0 pg Yr0 yos Yr0 yig FROM Yr0O WHERE Yr0 yig gt PGs ratio LowPG Int L HighPG Int LowHighPct Check for ba LowHighPct d data for compressed ratings owHighPct 10 Mod 10 LowHighPct Int LowHighPct If HighP
27. BA project vbCritical vbOKOnly End Select On Error GoTo 0 End Sub Sub ListReferencePaths Error To determine full path and Globally Unique Identifier GUID to each referenced library Select the reference in the Tools References window then run this code to get the information on the reference s library Dim i As Long With ActiveSheet Cells Clear Range A1 Reference name Range B1 Full path to reference Range C1 Reference GUID End With Cells 2 1 Select For i 1 To ThisWorkbook VBProject References Count With ThisWorkbook VBProject References 1 ActiveCell Nam ActiveCell Offset 0 1 FullPath ActiveCell Offset 0 2 GUID End With ActiveCell Offset 1 0 Select Next i On Error GoTo 0 End Sub 107 Choice form VERSION 5 00 Begin C62A69F0 16DC 11CE 9E98 00AA00574A4F frmChoice Caption show Chart ClientHeight 1800 ClientLeft 4050 ClientTop 1830 ClientWidth 3255 OleObjectBlob frmChoice frx 0000 End Attribute VB_Name frmChoice Attribute VB GlobalNameSpace Fals Attribute VB Creatable Fals Attribute VB PredeclaredId Tru Attribute VB Exposed Programming by Robert W Shuford CNA Option Explicit Private Dim End 108 short tis Select Case no e3 False Sub UserForm Initialize strName As String
28. ByVal f2 As String DoCmd RunSQL INSERT INTO Metadata f1 f2 SELECT amp fl _ amp AS f1 amp 2 amp AS f 2 End Sub Sub KillXL runs As Byte On Error Resume Next Dim Run As Byte i As Byte fn As Variant End Sub End fn Spl For Run For Next Next Sub On Error KillXL r For Run MkDi Next Sub it Expected Likelihood Shortage Sep Metadata Prom TISTIG 1 To runs i 0 To UBound fn Kill CurrentProject Path amp A 6 Run N amp fn i amp xls irs runs As Byte Resume Next MakeRunD Dim Run As Byte i As Byte fn As Variant uns 1 To runs r CurrentProject Path amp W amp Run Function Maximum ParamArray Values As Variant 64 Dim i As Maximum Use UB For i Integer Values 0 ound function to determine upper limit of array 1 To UBound Values If Values i gt Maximum Then Maximum Values i Next i End Function Sub XportMods Dim mdl As Variant strFile As String strExt As String For Each mdl In Application VBE ActiveVBProject VBComponents strFile bas If Left mdl Name 5 Form Then strFile cls mdl Export CurrentProject Path amp Modules amp mdl Name amp strFile Next Set mdl Nothing End Sub Private Sub PrntTrgts o As Byte y As Integer Dim i As Byte For i 3 To 9 Debug Print o 6 y 6 6 1 6 6 lngTarget
29. Din 6 rng Value2 Selection End x1Down Select ActiveCell CurrentRegion Select EMakeBoxPlot pg End Function Public Sub LikChart Optional pg As Byte 3 Optional yos As Byte 0 Dim i As Byte j As Byte k Sheets TIS Data Select Cells 2 3 Select As Byte yrs As Byte rng As Range stat As Single 95 96 Range Selection Selection End xlDown Select yrs EMax ReDim stat 3 4 yrs Sheets Likelihood Chart Select Range Cells 1 1 ELastCell ActiveSheet ClearContents Sheets Likelihood Data Select Cells 1 1 CurrentRegion Select Selection AutoFilter Field 1 Criterial rating Selection AutoFilter Field 3 Criterial pg Selection AutoFilter Field 4 Criterial yos Cells 1 6 Select Range Selection ELastCell ActiveSheet Select Sheets Add ActiveSheet Name Likelihood Chart Sheets Likelihood Data Select Selection Copy Sheets Likelihood Chart Select Cells 1 1 Select ActiveSheet Paste Cells 2 1 Select For i 1 To 4 For j 1 To yrs stat 1 i j ActiveCell Value2 stat 2 i j ActiveCell Offset 1 0 Value2 stat 3 i j ActiveCell Offset 2 0 Value2 ActiveCell Offset 0 1 Select Next Next Rows 1 4 Select Selection ClearContents Delete Shift xlUp Cells 1 1 Value2 rule C
30. ENs function in the Main module The programming code for the model can be found in appendix B 3 The Senior Rule first promotes those with the most Time in Service and then promotes progressively younger individu als These rules establish a range for the promotion tempos that could be achieved with a given force profile Table 4 Service requirements for promotion in months 228 36 Table 5 Navy time to promotion benchmarks 4 Paygrade Months E4 26 E5 53 E6 108 E7 148 E8 222 E9 266 Outputs The model produces outputs that allow for the analysis of e Personnel profile by Time in Service paygrade promotion rule and year e Time in Service and Time in Grade by paygrade promotion rule and year e Promotions by paygrade promotion rule and year 6 ENs is the name of a function in the model s programming and does not refer to the Navy s Engineman rating e Gaps between personnel and requirements by paygrade pro motion rule and year e Separations by paygrade promotion rule and year e Time to promotion by paygrade promotion rule and year e Likelihood of Promotion to the next paygrade for the current personnel inventory by Time in Service paygrade and pro motion rule The model also produces a table for each year named Yrl Yr2 etc The tables contain individual results so that an individual s career may be followed on a year by year basis
31. G LowPG 1 Then amp Exit Func End If DistributeHighPGs HighPG Change rate DoCmd RunSQL LowHighPct tion for high PGs UPDATE YrO SI LowHighPct As Single As String LowPG As Byte 2 amp ET Yr0 rate amp rating _ is u HighPG As Byte amp LowPG Is Null yos MsgBox There is a problem with the PG distribution for rating rating _ amp 6 vbCrLf 6 The high PG for the rating is HighPG _ but the low PG for amp Left rating u amp WHERE YrO rate nn amp Left rating 2 CurrentDb TableDefs Yr0 Fields rate Name rate2 GetPGRateCount Attrition rating LowPG HighPG DoCmd SetWarnings True End Function Private Function GetHighPGRatios rt As String As Single Dim rt2 As String recs As Long MinHigh As Byte MaxLow As Byte Dim rs As DAO Recordset rt2 Left rt 2 Get records into temporary table DoCmd RunSQL SELECT RealYr0 pg RealYr0 rate INTO rt _ amp FROM RealYr0 WHERE Left RealYr0 rate 2 6 rt2 _ amp AND RealYr0 rate lt gt amp rt2 amp Set rs CurrentDb OpenRecordset rt GetHighPGRatios rs RecordCount Get number in rating DoCmd RunSQL SELECT into tmp FROM amp rt amp WHERE amp rt _ amp M rate c e rt g Ww Set rs CurrentDb OpenRecordset tmp Ratio is to right of decimal GetHighP
32. GRatios rs RecordCount GetHighPGRatios Find highest PG in rating Set rs CurrentDb OpenRecordset SELECT Max amp rt pg As pg FROM _ rt amp rs MoveFirst High PG of uncompressed in tens place GetHighPGRatios GetHighPGRatios 10 rs Fields pg Set rs Nothing Find lowest PG in 2 character rating DoCmd RunSQL SELECT RealYr0 pg Count RealYr0 months AS cnt INTO Y amp rt 6 FROM RealYr0 WHERE RealYr0 rate 6 rt2 _ amp GROUP BY 6 RealYr0 pg Set rs CurrentDb OpenRecordset SELECT Min amp rt pg As pg FROM amp rt rs MoveFirst Low PG of compressed in ones place GetHighPGRatios GetHighPGRatios rs Fields pg Set rs Nothing DoCmd DeleteObject acTable rt DoCmd DeleteObject acTable tmp End Function Function DistributeHighPGs HighPG As Byte pct As Single Dim rs As DAO Recordset Randomize Set rs CurrentDb OpenRecordset Yr0 With rs MoveFirst Do Until EOF Select High PG records to delete If Fields pg gt HighPG And Rnd gt pct Then Edit Fields drop 1 Update End If MoveNext Loop End With Set rs Nothing End Function Function MakeRealYroO DoCmd SetWarnings False DoCmd RunSQL
33. L strSQL As String Dim varReturn As Variant Debug Print strSQL DoCmd RunSQL strSQL Sub Function RefreshLinks Dim dbs As Database tdf As TableDef Dim CurPath As String TblName As String CurPath CurrentProject Path Loop through all tables in the database Set dbs CurrentDb For Each tdf In dbs TableDefs If the table has a connect string it s a linked table If Len tdf Connect 0 Then TblName GetTableName tdf Connect tdf Connect DATABASE 6 CurrentProject Path amp WV _ amp TblName Err 0 On Error Resume Next tdf RefreshLink Relink the table Can t find the file so search up the path If Err lt gt 0 Then Do CurPath HigherPath CurPath Err 0 tdf Connect DATABASE 6 CurPath amp W _ amp TblName tdf RefreshLink Loop While Err lt gt 0 And Len CurPath gt 2 End If If Err lt gt 0 And tdf Name Yr0 Then MsgBox Err Description RefreshLinks False End If End If 63 End Next tdf Function Private Function GetTableName OldPath As String As String Dim bytSlash As Byte Do bytSlash InStr OldPath W OldPath Mid OldPath bytSlash 1 Loop Until bytSlash 0 GetTableName OldPath End Function Private Function HigherPath OldPath As String HigherPath Left OldPath InStrRev OldPath N 1 End Function Public Sub FeedMeta fl As String
34. Likelihood strSQL SELECT amp strOcc amp as rate amp as rule temp pg temp yos e omoted 1 Is Not Null 1 temp promoted 1 amp Is Not Null amp rule _ Count temp pg AS cnt 39 60 For i 1 To yrs strSQL strSQL amp Avg temp prom amp i AS av i Next strSQL strSQL amp 0 1111111111111111 AS likelihood INTO Likelihood _ amp FROM temp GROUP BY temp pg temp yos SOL strsQL strSQL UPDATE Likelihood SET Likelihood likelihood Likelihood av 1 For i 2 To yrs StrSQL strSQL Likelihood av i Next strSQL strSQL amp SQL strSQL Expected strSQL SELECT temp pg temp yos Count temp pg AS cnt For i 1 To yrs strSQL strSQL amp Avg temp prom amp i 6 AS av i Next strSQL strSQL 0 11111 AS Expected INTO Expected _ amp FROM temp GROUP BY temp pg temp yos temp promoted amp HAVING temp promoted 1 SOL strsQL StrSQL UPDATE Expected SET Expected Expected Expected yos Expected av 1 For i 2 To yrs strSQL strSQL amp Expected av 6 i amp amp i amp Next strSQL strSQL amp SQL strSQL Set rs Nothing End Sub Public Sub Expected Run As Byte NumYrs As Byte occrule As String Dim qdf As QueryDef i As By
35. SeriesCol S Chart Activate Chart 1 Activate ect Source Sheets TIS Range rng Address SeriesCollection Count Worksheets T ActiveChart SeriesCol lection i XValues _ IS Range SAS2 SAS 6 rng Rows Count Blue 37 Next For i 1 To yrs ActiveChart SeriesCol lection i Select lection i 3 1 Select Blue 41 Next For i 1 To yrs ActiveChart SeriesCol lection i 3 Select Blue 25 Next ActiveChart Deselect Set rng Nothing End Sub Private Sub Blue clr As Byte With Selection Border ColorIndex 2 Weight xlThin LineStyle xlContin End With Selection Shadow False uous Fals Selection InvertlfNegativ With Selection Interior ColorIndex clr Pattern xlSolid End With End Sub Robust Attribute VB Name Robust Programming by Robert W Shuford CNA Option Explicit Option Base 1 Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const 19 Const 20 Sub Robustness Dim strFN As String strPath As String Application ScreenUpdating False strPath ActiveWorkbook Path strFN ActiveWorkbook Name np Qd tuo WwW M Wood vo 00 JOU 4 GA ll JOWU0EWNDE O Ho WO OZ S Ei Sit H ll Sheets Array TISTIG Data Prom Data Shortage Data Sheets Sep Data
36. Set tdf CurrentDb CreateTab seit CHA Yr0 yos INTO Guys FROM YrO s strOcc amp With tdf MakeCommonFields tdf Fields Append CreateFi leDef SepData Fields Append CreateFie End With CurrentDb TableDefs Append td Sub Private Sub MakeShortTable Dim tdf As TableDef Set tdf CurrentDb CreateTab With tdf MakeCommonFields tdf Fields Append CreateFie Fields Append CreateFie End With CurrentDb TableDefs Append tdf Sub Private Sub MakePromTable Dim tdf As TableDef Set tdf CurrentDb CreateTab With tdf ld seps dbLo ld pct dbDou leDef Shortage ld target db ld shortage leDef Prom ng ble 2 Long dbLong MakeCommonFields tdf Fie Fie End With lds Append CreateFie CurrentDb TableDefs Append td End Sub Private Sub MakeTISTIGTable Dim tdf As TableDef Set tdf With tdf MakeCommonFields tdf Fields Append CreateFiel End With CurrentDb TableDefs Append tdf End Sub Private Sub MakeYOS PGTable Dim tdf As TableDef Set tdf With tdf MakeCommonFields tdf Fie Fie End With lds Append CreateFiel lds Append CreateFie lds Append CreateFiel CurrentDb CreateTab CurrentDb CreateTab CurrentDb TableDefs Append td End Sub Private Sub MakeCommonFields td As With td Fields Appen
37. Slash As Byte Do bytSlash InStr OldPath N OldPath Mid OldPath bytSlash 1 Loop Until bytSlash 0 GetTableName OldPath End Function Private Function HigherPath OldPath As String Returns path of parent directory HigherPath Left OldPath InStrRev OldPath 1 End Function Sub XportMods Dim mdl As Variant strFile As String strExt As String For Each mdl In Application VBE ActiveVBProject VBComponents strFile bas If Left mdl Name 5 Form Then strFile cls mdl Export CurrentProject Path amp Modules amp mdl Name amp strFile Next Set mdl Nothing End Sub 38 Appendix B PIAPM mdb programming code Table of contents Main Sub Driver Sub DoYears Private Function E9s Private Sub E9Sep Private Function ENs Private Sub ENSep Private Sub NewEls Private Sub AddSep Private Sub AddProm Private Function NewAccess Private Function CalcByoptPers Private Function Pred Preliminaries Sub MakeGuysTable Sub MakeTables Private Sub MakeSepTable Private Sub MakeShortTable Private Sub MakePromTable Private Sub MakeTISTIGTable Private Sub MakeYOS Private Sub MakeCommonFields Sub MakeMetaTable Sub GetTargets Sub ChangeTargets Function GetOccCount Function GetNewGuySepRate Stats Public Sub CompileData Public Sub GetDataForProbs Public Sub CalcProbs Public Sub Expected
38. These tables have the fol lowing naming convention Each is prefixed with the first letter of the rule and the rating currently being analyzed For example running the GSE rating for 5 years would produce e JGSEYrl JGSEYr2 JGSEYr5 MGSEYr1 MGSEY12 MGSEYr5 SGSEYr1 SGSEYr2 SGSEYr5 What the model does The following nested pseudo code provides a simplified summary of the model s process beginning with the current personnel inven tory For each run For each promotion rule Make preparations For each year Separate E9s 7 For formatting purposes in the final output the Benchmark Rule is iden tified by the letter M rather than B in order to allow Excel to use its default alphabetical ordering For each paygrade E8 E3 Separate Promote Next paygrade Access new E3s Compile data for year Next year Compile data for all years Cleanup Next promotion rule Next run When the user clicks the Run button any remaining tables from previous implementations are deleted and the target numbers for each paygrade are calculated simply by taking the number in each paygrade in Yr0 and adjusting for changes in requirements as en tered in the Increase Decrease Manpower Targets form New tables are created to hold the output data Each year up to the Number of Years input are handled in turn First the E9s in Yr0 are loaded into a temporary table named temp and merged with data for separation prob
39. Timer StartTime hr Int e 3600 e e 3600 hr min Int e 60 e e 60 min MsgBox Done amp vbCrLf Format hr 007 amp amp Format min 00 amp amp Format e 00 Elapsed End Sub Private Sub cmdKillXL DblClick Cancel As Integer KillXL CByte txtRuns MsgBox Files Deleted Delete End Sub Private Sub cmdXport Click XportMods MsgBox Modules Exported Export End Sub Personnel form VERSION 1 0 CLASS BEGIN END Attribute Attribute Attribute Attribute Attribute MultiUse VB Name VB VB_ VB_ VB_ l True GlobalNam Creatable Predeclar Form_Increas Fals Decrease Personn Spac True did Tru Exposed Programming by Robert Option Compare Database Explicit Option False W Shuford CNA Private Sub cmdUse Click NoChange End Sub Dim varReturn If IsNull frmChange Value AssignPers True DoCmd OpenForm Increase Decrease Manpower Targets Exit Sub Enter an Amount to Increase Decreas As Variant Then GoTo NoChange Public Sub AssignPers warn As Boolean Dim i As Byte Then optPersChange frmChange Value If Not IsNull txtNumPers Then sngPers CLng txtNumPers optPers 3 Elself Not IsNull txtPctPers sngPers CSng txtPctPers optPers 4 Else If warn Then GoTo NoType End If Exit Sub NoType MsgBo
40. User Manual for Personnel Inventory Aging and Promotion Model Robert Shuford CIM D0020718 A1 Final June 2009 e ANALYSIS amp SOLUTIONS Approved for distribution June 2009 pe LH Henry S Griffis Defense Workforce Analysis Team Resource Analysis Division This document represents the best opinion of CNA at the time of issue It does not necessarily represent the opinion of the Department of the Navy Approved for Pubic Release Distribution Unlimited Specific authority N00014 05 D 0500 Copies of this document can be obtained through the Defense Technical Information Center at www dtic mil or contact CNA Document Control and Distribution Section at 703 824 2123 Copyright O 2009 CNA Contents The Personnel Inventory Aging and Promotion PIAP model 1 So rc Datamd Da ds 3 MRO mdb e EET 3 Running the PIAP promotion model 6 lee 7 OUPS une EE E EE ARS a EE E ESEA 7 What the model does rn nme 8 PIAPM mdb the PIAP model 11 Controller form tete a 12 Increase Decrease Personnel Form 13 Increase Decrease Manpower Targets form 14 Warning form Jc socias o RT NU eb i RO EH 15 PIAP Gata PLOLESO A REA AAA 17 PIAPM SIS uii ona 17 Using he driver eere e p des 18 Importing new data uu ao ia 20 Compiling multiple runs eee 27 Sensitivity data eene n e ee O 27 The model is user configurable err Ir
41. a Dim intFiles As Integer strPath As String bytLikCol As Byte i As Integer Dim rate As String Application ScreenUpdating False Set wbDriver ActiveWorkbook bytLikCol 0 strPath ActiveWorkbook Path amp V Worksheets Likelihood Data Select Set wbNew Workbooks Add With Application FileSearch NewSearch LookIn strPath Filename Results xls Loop through files If Execute 0 Then For i 1 To FoundFiles Count Workbooks Open Filename FoundFiles i Set wb ActiveWorkbook Sheets Metadata Activate If i 1 Then rate Cells 3 2 Value2 If bytLikCol 0 Then bytLikCol Cells 2 2 6 MakeNewWB bytLikCol ElseIf bytLikCol lt gt Cells 2 2 6 Then MsgBox wb Name amp does not contain the same amp number of years as the previous file s amp vbCrLf amp vbCrLf amp All spreadsheets in amp strPath amp beginning with Results must amp have the same number of years Houston we have a problem wb Close False 78 wbNew Close False GoTo BadYrs End If CopyData Shortage CopyData Sep CopyData TIS CopyData Likelihood CopyData Prom CopyData TISTIG CopyData YOS PG Application CutCopyMode False wb Close False Next Else MsgBox No files found in current directory GoTo BadYrs End If End With blnDisableEvents True MakePivot Shortage MakePivot Sep Mak
42. abase SourceData mdb contains the base data compiled from the original data from the Defense Manpower Data Center DMDC A second database Yr0 mdb links to SourceData mdb and prepares the data for processing by the PIAP model which is contained in a third Access file named PIAPM mdb The model generates numerous Excel outputs that are compiled by PIAPM xls to produce statistics and charts describ ing the PIAP model s results Figure 1 below is a simple schematic that depicts the full process from input data to final results 1 We developed the model using Access 2000 its data processor was devel oped with Excel 2000 We tested both with the Office 2003 versions of these applications and found that they have full functionality Figure 1 Schematic of the PIAP model and data processor DMDC data Clean data Data prepa ration phase A Full data base HYT and TIS TIG requirements Loss data from DMDC Attrition rates Yr0 prepa ration phase Yr0 data Promotion model phase Outputs Excel phase Sensitivity data mp e p 2 High Year Tenure and Time in Service Time in Grade SourceData mdb In the interest of limiting the model s file size the base dataset SourceData mdb contains the data from DMDC and should be held inviolate It must contain the fields and data types as listed in table 1 Table 1 Source Data Fields Field Type Description ssn
43. abilities and the manpower requirement target for E9 Each record in temp is either separated or aged depending on the value of a random number 0 lt a lt 1 If this number is less than the separation probability for that rating rate paygrade pg and years of service yos combination then target is set to NULL otherwise yig is increased by 1 and months is It is common custom to denote database tables and fields by enclosing their names in brackets When it is necessary to refer to a field in a specific table the convention is to use the table name in brackets an exclamation mark and the field name in brackets e g table field 10 increased by 12 Now an SQL statement deletes records where target NULL and the model calculates the number of E8s that need to be promoted to reach the target for E9s The remaining records are loaded into a new table Yrl Paygrades E8 to E3 are then handled in descending order Each paygrade in turn is loaded into temp from Yr0 along with the separation probabilities and the manpower requirements in the process destroying the old temp table These are sorted and in dexed by months depending on the promotion rule If it is the Junior Rule then the records are in ascending order they are in descending order if it is the Senior Rule For the Benchmark Rule the records are in ascending order of the absolute value of the dif ference between Time in Servi
44. acQuery b2 58 Next End Sub Public Sub GetDataForProbs yrs As Byte Compiles data for Yr0 PG months cohots Dim i As Byte Dim strSelect As String strFrom As String s SOL UPDATE Guys SET Guys yos 0 WHERE Guys Create SOL statement in segments trWhere As String ssn Like PARAR E strSelect SELECT Guys ssn Guys pg Guys yos strFrom FROM For i 1 To yrs strFrom strFrom amp Next strFrom strFrom amp Guys For i 1 To yrs strSelect strSelect Yr amp i amp pg AS pg amp i amp Yr i amp prom mnths AS prom mnths amp i strFrom strFrom amp LEFT JOIN Yr i amp ssn Next For i 1 To yrs strSelect strSelect amp 0 AS prom Next ON Guys ssn Yr amp i _ i strSelect strSelect amp 0 AS promoted INTO temp Whew finally run it SQL strSelect amp amp strFrom 6 amp strWher DoCmd DeleteObject acTable Guys End Sub Public Sub CalcProbs yrs As Byte rule As String Dim i As Byte strSQL As String Set rs CurrentDb OpenRecordset temp SOL UPDATE temp SET temp prom 1 1 temp pr amp WHERE temp prom mnthsl For i 2 To yrs SQL UPDATE temp SET temp prom amp i amp amp WHERE temp prom mnths amp i amp AND temp promoted 0 Next
45. aintain correct sorting SOL CREATE INDEX kKey on temp months amp strRule rule amp ssn End If t rs CurrentDb OpenRecordset temp New accessions lngCurrCnt If pg 3 Then lngAccess NewEls yr Need Di E Set rs rs RecordCount CurrentDb OpenRecordset temp nd If rs Index NSep yr pg Ed Calcul kKey late needs Ns lngTarget pg rs RecordCount Set rs Nothing Promote Age months of service SQL UPDATE temp SET temp months months 12 temp yig yig 1 _ amp temp yos yos 1 temp mos pg mos pg 12 Set rs CurrentDb OpenRecordset temp Maintain correct sorting rs Index kKey AccumulatedShortage AccumulatedShortage Need W ith rs MoveFirst Do Until LE EOF Or Need lt O months gt min tis pg 1 And mos pg gt min tig pg 1 Then Promote Edit pg pg 1 lyig 0 mos pg O lngProms lngProms 1 prom mnths months target lngTarget pg 1 47 Update Need Need 1 End If MoveNext Loop End With Set rs Nothing AccumulatedShortage AccumulatedShortage lngProms If pg 3 Then ENs lngCurrCnt Else ENs ENs lngProms Append to YrX table SQL INSERT INTO Yr amp yr 1 amp ssn pg rate months _ yig yos mos pg prom mnths tar
46. amp W SepData Next KillReportTables varReturn SysCmd acSysCmdClearStatus DoCmd SetWarnings True Sub Loop through years and PGs Sub 42 DoYears occ As Byte MaxYear As Byte Dim i As Integer bytYr As Byte Dim lngOldTarget As Long ChangeTargets occ Add Yr0 to TIS TIG table SOL INSERT INTO TISTIG m TIG y SEL strRule rule amp Count Yr0 ssn Avg Yr0 mos_pg rule E rate WWW AS rule AS cnt e Rem m SEE Expected Likelihood Shortage amp varReturn amp yr ECT YrO rate AS rate 0 AS yr Avg Yr0 months AS TIG FROM YrO0 GROUP BY Yr0 rate Reset random number generator to be as consistent as possible strOcc amp strRule frameRules amp occ strOcc Yr gi EYr amp i amp amp i acTable acTable AllYrs e Expected acTable Likelihood acTable acTabl Metadata Prom 8 varReturn xls True uv rule As Byte lngNeed As Long cnt DES Y Pg wun Yr pqgy Y AS TIS Y Yr0 pg CurrentProject Path _ Loop through years For bytYr 0 To MaxYear 1 AccumulatedShortage 0 Increase or decrease manpower Select Case optManChange l time change Case 1 If bytYr 1 Then GetTargets Permanent change Case 2 Change every year Case 3 If bytYr 0 Then ChangeTargets CByte occ Mod 10 bytYr End Select H
47. anpower And Personnel Classifications And Occupational Standards Volume II Navy Enlisted Classifications NECs January 2004 4 This information is administratively sensitive and was provided by the project sponsor 113 This page intentionally left blank 114 List of figures Figure 1 Schematic of the PIAP model and data processor 2 Figure 2 YrO database wiInd W wiwa dica wd 4 Figure 5 Controller form uite oput a nan 12 Figure 4 Increase Decrease Personnel Form 13 Figure 5 Increase Decrease Manpower Targets form 14 Figure 6 Database exceeds Gba id deca 16 Figure 7 Database exceeds 1 5 Gb and is projected to fail 16 Figure 8 Import Compile and Sensitivity buttons 18 Figure 9 Years of service by paygrade sse 20 Figure 10 Time in Service Time in Grade 21 Figure LL From Ee wano Cd teret ti i ut efe sva usd tuit ten 22 Figure 12 Shortage chart ceno oerte ecu de t on eet 23 errereen 24 Eigute DE RE 25 Figure 15 Likelihood chart us ett ta tete e ege 26 Figure 16 BoX EE 28 Figure 17 Open Chart Form button o eret tree 29 Figure 18 Robustness of promotion rates 30 115 116 This page intentionally left blank List of tables Table 1 Table 2 Table 3 Table 4 Table 5 Source Data Eeer 3 RealAttrRat s E 3 TW TE D Service requirements for promotion in months 7 Navy time to promotion benc
48. as sign approximately 30 E9s to the ZZB rating 8 Creates two new tables in the database a PGRollup has nine records containing the number of records in Yr0 for each paygrade b RateRollup has one record with the total number of records in Yr0 9 Selects records from the RealAttrRates table that have the three character rating for uncompressed paygrades and the two character rating for compressed paygrades and it puts them into a new table named AttrRates The final Yr0 table has the following structure Table3 Yro fields Field Type Description ssn Text Psuedo SSN for tracking individuals year by year pg Integer Paygrade rate Text The two or three character rating yos Integer ears of service yig ears in grade months Integer Months of service mos pg Integer Months in grade Drop Long Unused Running the PIAP promotion model The model produces three sets of outputs for each run and each set uses a different promotion rule l The Junior Rule first promotes those with the least Time in Service assuming they meet the minimum requirements and then it promotes progressively older individuals See table 4 for minimum Time in Service Time in Grade re quirements 1 2 The Benchmark Rule first promotes those individuals whose Time in Service is closest to the established Navy benchmarks See table 5 for the benchmarks currently in use These can be changed by altering the
49. astCell ClearContents Cells 1 1 Select ActiveCell Value2 rating wbNew Activate ActiveCell CurrentRegion Copy wbDriver Activate If str Likelihood Then Cells 1 2 Select ActiveSheet Paste ActiveCell CurrentRegion Columns AutoFit Select Case str Case YOS PG TISTIG Prom Shortage Sep RefreshPivot str Case TIS RefreshPivot str FixTISChart FixAxis bytYrs Case Likelihood Sheets str amp Data Select With Selection AutoFilter AutoFilter Field 4 Criterial Cells 2 4 Value2 End With FixLikChart bytYrs KillLikSeries End Select wbNew Activate End Sub Private Sub KillLikSeries ActiveSheet ChartObjects Chart 1 Activate ActiveChart ChartArea Select On Error GoTo Done Do While True 86 Loop Done End Sub ActiveChart SeriesCollection bytYrs 1 Delete 87 Formatting Attribute VB Name Formatting Programming by Robert W Shuford CNA Option Explicit Option Private Module Public Sub FixLikChart yrs As Byte 88 Dim l cols As Byte l rows As Long l address As String i As Byte Sheets Likelihood Data Activate Determine number of years ActiveSheet AutoFilterMode False l cols yrs 5 Range Cells 1 6 Cells 1 1l cols Select Selection Replace What av Replacement Yr LookAt xlPart SearchOrder xlByRows MatchCase False Range Selection Selection End xlDown Select l address S
50. balNameSpace Fals Attribute VB Creatable Fals Attribute VB PredeclaredId True Attribute VB Exposed True Programming by Robert W Shuford CNA Option Explicit Private Sub Workbook Open Const BUTTONS 4 Dim i As Byte On Error GoTo BarExists Add toolbar and button Application CommandBars Add New Data msoBarBottom True Visible True For i 1 To BUTTONS Application CommandBars New Data Controls Add _ Type msoControlButton id 2950 Before 1 Next Set buttons NewButton 1 New Data Import New Data LoopDirs NewButton 2 New Data Compile Multiple Files CompileAllData NewButton 3 New Data Sensitivity Data Robustness NewButton 4 New Data Export Modules XportMods BarExists End Sub Private Sub NewButton item As Byte bar As String caption As String macro As String With Application CommandBars bar Controls item Style msoButtonCaption caption caption OnAction macro BeginGroup True End With End Sub Private Sub Workbook BeforeClose Cancel As Boolean KillCmdBar End Sub 110 Sheet4 VERSION 1 0 CLASS BEGIN MultiUse END Attribute Attribute Attribute Attribute Attribute Application Scree If Not blnDisable VB VB_ VB VB_ VB_ True Name Sheet4 GlobalNameSpace False Exposed Worksheets Y ActiveSheet Cells 1 1 Activate Selectio
51. ce months and the benchmark for that paygrade The records are chosen for separation in the manner described above and deleted from temp and the number of promotions needed for the next lower paygrade is calculated months and Time in Grade mos_pg are increased by 12 for the remaining records and the program moves through the sorted records promoting each individual that is eligible until either there is no further need for more promotions or until the end of the data is reached Those promoted have Years in Grade yig and mos_pg set to 0 otherwise yig increases by 1 and mos pg increases by 12 The records are loaded into Yr1 and the next paygrade is processed At this point data for Time in Service Time in Grade separations and promotions are collected in tables that will be output later Fi nally the number of required accessions to E3 is calculated on the basis of current end strength predicted first year attrition and the manpower requirements entered by the user The new E3s are added to Yr1 and each is assigned a unique identifier in the ssn field These are easily identified in the yearly table because the first character is the letter A When this process is completed for each year the statistics are com piled and loaded into new tables First AllYrs is created with the 9 Structured Query Language the industry standard language used by Access to manipulate database tables help of te
52. d frmChoice Show NewModLine CodeMod End Sub NewModLine CodeMod Private Sub Workbook BeforeClose Cancel As Boolean NewModLine CodeMod On Error Resume Next NewModLine CodeMod Application CommandBars Robust Delete NewModLine CodeMod On Error GoTo 0 NewModLine CodeMod End Sub End Sub Private Sub NewModLine modl As VBIDE CodeModule code As String modl InsertLines modl CountOfLines 1 code NewModLine num 1 End Sub Sub AddReference strGUID As String Dim theRef As Variant i As Long SErGUID 00020905 0000 0000 C000 000000000046 On Error Resume Next Remove any missing references For i ActiveWorkbook VBProject References Count To 1 Step 1 Set theRef ActiveWorkbook VBProject References item i If theRef IsBroken True Then ActiveWorkbook VBProject References Remove theRef End If Next Err Clear Add the reference 106 ActiveWorkbook VBProject References AddFromGuid _ GUID strGUID Major 1 Minor 0 Select Case Err Number Case Is 32813 Reference already in use No action necessary Case Is vbNullString Reference added without issue Case Else An unknown error was encountered so alert the user MsgBox A problem was encountered trying to vbNewLine _ amp add or remove a reference in this file amp vbNewLine _ amp Please check the amp references in your V
53. d CreateFiel Fields Append CreateFiel Fields Append CreateFiel Fields Append CreateFiel Fields Append CreateFiel End With End Sub Sub MakeMetaTable yrs As Byte Make new table Dim tdf As TableDef ld proms dbDouble ld pct dbDouble leDef YOS_PG ld yos dbByte leDef TISTIG d TIS dbDouble ld TIG dbDouble TableDef d rate dbText d rule dbText d pg dbByte d d yr dbByte cnt dbLong AltYIG As Variant Set tdf CurrentDb CreateTableDef Metadata With tdf Fields Append CreateFiel Fields Append CreateFiel d f1 dbText d f2 dbText 33 54 End With CurrentDb TableDefs Append tdf Set tdf Nothing Add info from Controller FeedMeta Date Now FeedMeta Years yrs FeedMeta Rating strOccArray 0 Set rs CurrentDb OpenRecordset Yr0 rs MoveFirst Add info from Personnel Dim str As String i As Byte j As Byte Select Case optPersChange Case 1 str l time change Case 2 str Permanent change Case 3 str Constant change End Select FeedMeta Personnel Change Type str Select Case optPers Case 1 3 str Number Case 2 4 str Percentage End Select FeedMeta Personnel Change Number Type str Select Case optPers Case 1 2 For i 0 To 8 FeedMeta Change CStr sngIntDecPers i
54. d processing the data the driver wil save the file with the name Re sults date timexls where date is the current date and time is the cur rent time This results in one Excel file for each run Note The driver opens and creates literally hundreds of workbooks and must keep track of each so it is strongly recommended that the user al low the program to complete without interference i e the user 11 Date is in the format MMDDYY and time is in the format HHMMSS should not attempt to use or activate any other application until it is finished otherwise the driver will likely fail Clicking the Compile Multiple Files button imports the data from files created by the Import New Data procedure It will attempt to import all Excel files whose name begins with Results so it is necessary to remove all of the files created by a previous run If these old files used a different number of years the program will in form the user and abort but if the same number of years were used but with different inputs the consequence will be a mixture of re sults The user could inadvertently attempt to analyze data pro duced from multiple possibly contradictory assumptions The compiling procedure takes the results of these files averages them and calculates the standard deviations minimums and maximums We do this to smooth out the variation among the PIAP model s runs These smoothed data are used to produce a new file contain
55. e future unless steps are taken Since the model accesses to end strength and not simply to fill the E3 billets we see overages repre sented by negative shortages in the first and fourth year due to the gaps for E4 and E6 respectively The variation from zero in the second and third years for E3s is the result of imperfectly predict ing first year attrition for the new accessions Figure 12 Shortage chart 13 In this example when all ten runs are compiled as described later the average gap for E6s in the fourth year is 33 7 approximately 14 per cent 14 f These variations from requirements are in the 1 to 2 percent range Figure 13 Sep Chart 29 24 The Sep chart shows loss rates year by year in each paygrade and for each promotion rule The unexpectedly large E9 attrition in the first year is reflective of both the small number of E9s in this rating and the large percentage of E9s in our data that are just reaching retirement eligibility in the first year of the model All of our E9s and nearly three fourths of our E8s are eligible to retire The TIS Chart gives the user a view by paygrade and year of time to paygrade in months at the time of promotion for those who promoted in that year The stacked bars show time for the Junior Benchmark and Senior Promotion Rules in blue dark blue and light blue respectively Figure 14 TIS Chart 15 Time in Service Months deviation from benchma
56. e2 1 STD Cells 1 col 4 Value2 Max Range Cells 1 col 5 ELastCell ActiveSheet ClearContents InsertID id Range Al Select Sub Private Sub MakeCharts MakeChart Count MakeChart AveTIS MakeChart AveTIG MakeChart YOS PG MakeChart Prom MakeChart Shortage MakeChart Sep MakeChart TIS Sheets Likelihood Data Select Sheets Add ActiveSheet LikChart End Sub Public Function MakeChart dat As String Optional pg As Byte 4 Nam Dim yrs As Byte Sheets dat amp Range Cells 1 1 Sheets dat amp yrs EMax Likelihood Chart rng As Range Chart Select ELastCell ActiveSheet ClearContents Data Select Cells 2 3 Select Range Selection Selection End x1Down Select Selection CurrentRegion Select Selection AutoFilter Field Selection AutoFilter Fiel Cells 1 3 Select 1 Criterial rating d 2 Criterial pg Range Selection Selection Copy ELastCell ActiveSheet Select Sheets dat amp Chart Select Cells 1 2 Select ActiveSheet Paste Cells 1 1 Value2 rule Cells 2 1 Value2 J Cells yrs 2 1 Value2 M Cells 2 yrs 2 1 Value2 S Cells 2 2 Select Next Range Selection For Each rng In Selection rng Value2
57. ePivot TIS MakePivot Likelihood MakePivot Prom MakePivot TISTIG MakePivot YOS_PG wbDriver Activate Application DisplayAlerts False CopyAllSheets Sheets Metadata Delete FixLikChart bytYrs FilterLikely FixTISChart FixAxis bytYrs RefreshPivot Sep RefreshPivot Shortage RefreshPivot Prom RefreshPivot TISTIG RefreshPivot YOS PG Application DisplayAlerts True ActiveWorkbook SaveAs strPath 6 Compiled 6 rate amp 79 amp Application FileSearch FoundFiles Count amp Files amp bytYrs amp Yrs amp xls BadYrs blnDisableEvents False wbNew Close False Set wb Nothing Set wbNew Nothing Set wbDriver Nothing Application ScreenUpdating True End Sub Private Sub MakeNewWB bytLikCols As Byte Dim i As Integer wbNew Activate Application DisplayAlerts False For i Worksheets Count To 2 Step 1 Worksheets i Delete Next For i 2 To DATASHEETS Sheets Add After Worksheets Worksheets Count Next i 1 Sheets i Select ActiveSheet Name YOS_PG Data CommonData Cells 1 6 yos i i 1 Sheets i Select ActiveSheet Name TISTIG Data CommonData Cells 1 6 tis Cells 1 7 tig i i 1 Sheets i Select ActiveSheet Name Prom Data CommonData Cells 1
58. ed to the Yr0 mdb database so as not to make the model unnecessarily large Due to Access inherent inefficiencies the model s file size grows rapidly so the user must compact it fre quently To do this click on the menu bar Tools Database Utili ties Compact and Repair Database The database will perform this automatically when it is closed 11 Controller form Figure3 Controller form JE xj When the model opens the Controller form auto 12 matically opens The form has two text boxes for Number of Years user input three visible buttons and two hidden buttons in the bottom left and right hand corners The user enters the Number of Years required into the future for which the model will project and gen erate data The user also enters the number of runs that the model will make in order to smooth out the variations that occur We explain why this is neces sary later in this document A subdirectory for each run will be created in the model s directory to hold Rm its outputs The Kill Tables button deletes all tables and queries created by the model including those that were not destroyed during program execution because of an error or user intervention leading to program termination All of these tables are deleted at the beginning of each run but this button allows the user do so at will usually before closing the file to reduce its storage size The hidden button in the bottom right hand corner del
59. election Address l rows Selection Rows Count ActiveWorkbook Sheets Likelihood Chart Activate Set source data for chart ActiveSheet ChartObjects Chart 1 Activate With ActiveChart For i 1 To 1 cols 4 SetSourceData Source Sheets Likelihood Data Range l address Next End With ActiveChart SeriesCollection 1 XValues Likelihood Data R2C2 R amp l rows amp C3 ActiveSheet Cells 1 3 Select ActiveSheet Shapes cboLikYOS Select Selection ListFillRange B1 B31 ActiveSheet OLEOb jects cboLikYOS Object Value Cells 1 2 ActiveSheet Cells 1 3 Select End Sub Public Sub FixTISChart Refresh pivot table Sheets TIS Pivot Select RefreshPivot TIS Set source data for controls Sheets TIS Chart Select ActiveSheet Cells 1 3 Select End Sub Public Sub FixAxis numyrs As Byte Dim i As Byte o As Byte ws tp As Worksheet Set ws tp ActiveWorkbook Sheets TIS Pivot ActiveWorkbook Sheets TIS Activate Range Cells 1 1 Cells SpecialCells xlLastCell ClearContents Cells 1 1 Select ActiveCell Value2 PG ActiveCell Offset 0 1 Select For i 1 To numyrs ActiveCell Value2 Junior amp i ActiveCell Offset 0 1 Select ActiveCell Value2 Bench amp i ActiveCell Offset 0 1 Select 0 ActiveCell Value2 Senior amp i ActiveCell Offset 0 1 Select Ne
60. ells 1 2 Value2 year Cells 1 3 Value2 Min Cells 1 4 Value2 1 STD Cells 1 5 Value2 Pct Cells 1 6 Value2 1 STD Cells 1 7 Value2 Max Cells 2 1 Value2 J Cells yrs 2 1 Value2 M Cells 2 yrs 2 1 Value2 S Cells 2 2 Select For k 1 To 3 For i 1 To yrs With ActiveCell Value2 6 i Offset 0 1 Value2 Offset 0 2 Value2 Offset 0 3 Value2 Offset 0 4 Value2 Offset 0 5 Value2 Offset 1 0 Select End With Next Cells yrs 2 2 Select Next Cells 1 1 CurrentRegion Select EMakeBoxPlot pg Sub yos EMakeBoxPlot pg As Byte Optional Dim ws As String rngR As String On Error Resume Next GoTo BoxErr title PG pg If yos lt gt 99 Then title title amp ws ActiveSheet Name rngR Selection Address Charts Add With ActiveChart HasTitle True ChartTitle Characters Text ChartType xlLineMarkers stat k 3 i Min stat k 1 i stat k 2 1 1 STD stat k 1 i base stat k 1 i stat k 2 i 1 STD stat k 4 1 Max yos As Byte 99 title As String w YOS Y yos title SetSourceData Source Sheets ws Range rngR Location Where xlLocationAsObject Name ws End With With ActiveChart SeriesCollection 1 Select With ChartGroups 1 HasDropLines False HasHiLoLines True HasUpDownBa
61. emp prob sep prob sep 1 amp sng WHERE prob sep lt gt 1 Maintain correct sorting SQL CREATE INDEX kKey on temp bm ASC ssn Else SQL SELECT Yr amp yr amp ssn Yr amp yr pg Yr yr amp amp Yr amp yr amp yr amp yos months Yr Yr amp yr amp yig Yr _ amp yr amp mos pg m amp O AS prom mnths lngTarget pg AS target amp INTO temp FROM Yr amp yr amp INNER JOIN AttrRates amp ON Yr amp yr amp yos AttrRates yos amp AND Yr amp yr amp rate AttrRates rate amp AND Yr amp yr amp pg AttrRates pg amp WHERE Yr yr amp rate amp strOcc amp amp AND Yr amp yr pg amp pg _ amp ORDER BY Yr amp yr amp months amp strRule rule amp amp yr amp ssn Change attrition rates SOL UPDATE temp SET temp prob sep prob sep 1 sng amp WHERE prob sep lt gt 1 Adjust attrition rates for change in E5 HYT If pg 5 Then SOL UPDATE 1 WHERE temp SET temp prob sep temp months AttrRates prob sep rate v p ABS Yr u u trRule 1 amp Yr LossChange pg rate u u Yr LossChange pg lt U S amp 120 E5SADJ 12 yr AND temp yos gt 14 End If M
62. ene deans 31 Appendix A Yr0 mdb programming code sess 33 Table Of COMETS o Cdi de AR AA 33 AUCTORE i geii M 34 Appendix B PIAPM mdb programming code sees 39 Table ER 39 hui RE 41 Preliminaries is 52 A M M 58 Minn M M 62 Controller form eere ee ete tie e ce geiles 66 Personnel Form 68 Manpower E 69 Appendix C PIAPM xls programming Code eese 71 Table OF contents 71 Mat 73 Compile d is dais tibias 78 Formatting ee 88 RODU ni OG OWE EA AAA AAA HS 92 gii E 100 Choice TOTIS tede Pelr S Pe UU S ES AP RR UAI YMO UE 108 Workbook C 110 DIC OL d S 111 jg M NO GEE AOR AA NAGA 112 Eege 113 Le e 115 IR E EEN 117 The Personnel Inventory Aging and Promotion PIAP model This manual describes not only how to use and maintain the PIAP model but it also discusses its development structure usage and outputs Additionally the manual provides guidance for interpret ing the results The PIAP model can be used to examine the effect of various man power policy implementations and their future consequences to the Navy s personnel profile The user may analyze how policy changes will affect promotion tempo promotion rates likelihood of promo tion separation rates and gaps between requirements and person nel The PIAP model incorporates several files in two different formats Access and Excel The Access dat
63. er paygrades Determines the paygrade where the rating becomes com pressed and calculates the ratio for distributing the com pressed paygrades Queries the RealYrO table for all records with the rate field equal to either the two or three character rating and stores them in a new table named Yr0 Promotes all Els and E2s to E3 Deletes all records where any of the Time in Service or Time in Grade fields are missing or if Time in Grade is greater than Time in Service Warns the user if there is an overlap or a gap between the compressed and uncompressed paygrades The user is asked to resolve the problem and code execution ceases Identifies each three character rating that feeds into the compressed paygrades and calculates the proportion of the chosen rating among the uncompressed paygrades It then randomly selects records among the compressed paygrades in this proportion Those not selected are dropped from Yr0 and the rating is changed to the chosen three character rating for those selected Since the selection for distribution is random one execution of this macro will not result in the same dataset as that of another execution For example suppose the ratings ZZA ZZB and ZZC composed of 10 000 sailors combine into the rating ZZ at E9 with 100 sailors and that there are 5000 ZZAs 3000 ZZBs and 2000 ZZCs at paygrades E3 ES If the user chose the rating ZZB the model would randomly
64. ete old data ws_t Activate Range Cells 1 1 Cells SpecialCells xlLastCell ClearContents TISHeader ws l Activate ActiveSheet AutoFilterMode Fals Range Cells 1 1 Cells SpecialCells xlLastCell ClearContents rating GetRating For Each rule In Array J M S On Error Resume Next Workbooks OpenText Filename ActiveWorkbook Path _ amp NV 6 run 6 NExpected amp rating rule xls If Err lt gt 1004 Then On Error GoTo 0 yrs ActiveWorkbook Worksheets Count For yr 1 To yrs FixGetExpected Next Workbooks Expected amp rating amp rule amp xls Close False 73 74 Workbooks OpenText Filename ActiveWorkbook Path _ amp VN amp run amp Likelihood rating 6 rule amp xls Set wb ActiveWorkbook FixLikely GetLikely Workbooks Likelihood amp rating amp rule amp xls Close False End If Next On Error GoTo 0 GetNewData Sep RefreshPivot Sep GetNewData Shortage RefreshPivot Shortage GetNewData Prom RefreshPivot Prom GetNewData TISTIG RefreshPivot TISTIG GetNewData YOS PG RefreshPivot YOS PG ActiveSheet PivotTables PivotTablel PivotFields rule CurrentPage M ActiveSheet PivotTables PivotTablel PivotFields yr CurrentPage 1 rate Metadata Sheets Metadata Activate Fh Z Fh ct Fh ct z
65. etes the output files in the subdirectories These files are also deleted at the beginning of each run This button requires a dou ble click because these deletions are permanent and the files cannot be recovered from the Recycle Bin The hidden button at the bot tom left hand corner requires only a single click and exports all of the form and code modules to a subdirectory named Modules that must already exist in the same directory where the model resides For both of these hidden buttons a message box alerts the user that the operation was successful Clicking the Change Req s Pers but ton opens the Increase Decrease Personnel form and clicking the Run button begins the model s execution Increase Decrease Personnel Form Figure 4 Increase Decrease Personnel Form EJ Increase Decrease Personnel 10 x Change in Personnel Enter the change in personnel as either choose only one a The number of personnel b Percentage increase This form allows the user to add or sub tract accessions The user can select a one time change a permanentstep change the same number or percent change every year or a constant rate of change By default the model accesses to E3 the number that it predicts it will need to meet the personnel end strength requirements By entering a number in the first text box the model will access that number over and above requirements This is equivalent to changing the E3 requi
66. get SELECT temp ssn temp pg temp rate temp months Er v MPM FROM temp Add to Promotion table AddProm yr 1 pg lngProms lngCurrCnt End Function Private Sub ENSep yr As Byte pg As Integer Dim losses As Long cnt As Long sep As DAO Recordset losses 0 With rs MoveFirst Separate Do Until EOF Edit Go through each record and decide whether to separate If Rnd prob sep Then target Null losses losses 1 End If Update MoveNext Loop End With AddSep yr 1 pg losses lngCurrCnt Delete seps SOL DELETE temp target FROM temp WHERE temp target Is Null End Sub New accessions Private Sub NewEls yr As Byte promoted As Long Static id As Long 48 temp yig temp yos temp mos pg temp prom mnths temp target _ lngAccess Round NewAccess yr Dim i As Long With rs For i 1 To lngAccess id id 1 AddNew Create unique ID ssn A 6 Format id lpg 3 Rate strOcc months 0 lyig 0 lyos 0 mos pg O prob sep ElSep prom mnths Null target lngTarget 3 Update Next End With Set rs Nothing promoted Pred AccumulatedShortage 00000000 If yr 0 Then SOL INSERT INTO Guys ssn pg SELECT temp ssn temp pg _ amp FROM temp WHERE temp ssn Like A Y FeedMeta strOcc strRule frameRules amp Year _
67. he robustness of the model the user should open the file created by clicking the Com pile button and click the Sensitivity Data button Clicking this but ton while the previously created compiled data file is active will provide the user with a new tool to examine the robustness of the PIAP model and it will help the user determine whether there is too much variation among the runs to be useful If the user con cludes this to be the case he she may try increasing the number of runs in the model If this does not improve the results it may be that the number of individuals in that rating is too small to model reliably This new file will be named Sensitivity Data for rat ing runs Files years Years xls The sensitivity data are presented in the form of bar charts with indicators for mean minimum maxi mum and plus or minus one standard deviation 27 Figure 16 Box plot charts T ik T m gt DE z Em eH el SJ SE M oup UT m 0 05 In Figure 16 we see the variation in promotion rates for E4s in each year under each promotion rule To see the promotion rates for other paygrades the user should click the Open Chart button at the top right of the screen shown in Figure 16 to open a context sensi tive form and explore the data As shown in Figure 17 the user should select the desired inputs and click the Create Chart button to add a new chart for comparison or for export Checking the De lete all old char
68. hmarks 4 7 117 This page intentionally left blank 118 CIM D0020718 A1 Final o 4825 Mark Center Drive Alexandria VA 22311 1850 703 824 2000 www cna org ANALYSIS amp SOLUTIONS
69. ination TableName PivotTablel ActiveSheet PivotTableWizard TableDestination ActiveSheet Cells 3 1 ActiveSheet Cells 3 1 Select ActiveSheet PivotTables PivotTablel SmallGrid False ActiveSheet Name str amp Pivot bytBadCol 3 Select Case str Case YOS PG CommonFields With ActiveSheet PivotTables PivotTablel PivotFields yos Orientation xlRowField End With FieldSets 5 cnt pg bytBadCol 4 Case TISTIG CommonFields FieldSets 4 tis tig Case Prom CommonFields FieldSets 4 cnt proms pct Case Shortage CommonFields FieldSets 4 cnt target shortage Case Sep CommonFields FieldSets 4 cnt seps pct Case TIS CommonFields FieldSets 4 cnt AvgOfprom mnths Case Likelihood CommonFields LikFieldSets bytYrs End Select With ActiveSheet PivotTables PivotTablel PivotFields Data Orientation xlColumnField Position 1 End With CleanPivot str bytBadCol End Sub Sub CommonFields Dim i As Byte i 1 With ActiveSheet PivotTables PivotTablel With PivotFields rule Orientation xlRowField Position i poe ay ad End With With PivotFields pg Orientation xlRowField Position i denk I End With With PivotFields yr Orientation xlRowField Position i y exa End With End With
70. ing 5 End If End With End Function Private Function GetTableName OldPath As String As String Dim bytSlash As Byte Do bytSlash InStr OldPath OldPath Mid OldPath bytSlash 1 Loop Until bytSlash 0 GetTableName OldPath End Function Function CopyModule ModuleName As String FromVBProject As VBIDE VBProject 102 ToVBProject As VBIDE VBProject _ OverwriteExisting As Boolean As Boolean N NN NN NN AAA AAA AAA AA AAA A A NN SN SN SN SN SN SN AAA AAA AA GS GS GN GN A NN SN SN NN SN SN AAA AAA CopyModule This function copies a module from one VBProject to another It returns True if successful or False if an error occurs Parameters FromVBProject The VBProject that contains the module to be copied ToVBProject The VBProject into which the module is to be copied ModuleName he name of the module to copy OverwriteExisting If True the VBComponent named ModuleName E in ToVBProject will be removed before importing the module If False and a VBComponent named ModuleName exists in ToVBProject the code will return False MOMO VO AAA Dim VBComp As VBIDE VBComponent Dim FName As String MOMO VO AAA Do some housekeeping validation If FromVBProject Is Nothing Then CopyModule False Exit Function End If If Trim ModuleName vbNullString Then CopyModule False Exit Function End If
71. ing all of the datasheets pivot tables and charts contained in the individual files plus the extra metadata statistics created during the compiling process The driver saves the compiled data to a file named Compiled runs Files years Yrs xls where runs is the number of runs and years is the number of years used in the PIAP model While promotions in this model are deterministic the separation aspect is random at the individual level making the model a stochas tic process The probability of separation is assigned to each indi vidual by rating paygrade and years of service based on a weighted 5 year average Thus it is necessary to get an idea of the robustness of the model With the file created by the Compile Multiple Files procedure open and activated clicking the Sensitivity Data button will produce a new tool for examining the variation across all runs of the PIAP model 19 Importing new data Upon clicking the Import New Data button the program loops through the runs and promotion rules opening each spreadsheet produced by the PIAP model and saving a new file for each run We now examine the result of a single run The YOS PG Chart shows the number of sailors with a GSE rating in each year of service by stacked paygrade in the first year using the Benchmark Rule Figure 9 Years of service by paygrade 9 E s with 12 YOS 28 Es with 12 YOS 8 ESs with 12 YOS 12 3 4 5 6 7 8 9 0 11 12 13 14 15 16 17 18 19 20 21 22
72. lWithData col Create the range object Set ELastCell TheSheet Cells Row col End Function Public Sub RefreshPivot str As String Dim s_address As String Sheets str amp Data Select Cells 1 1 CurrentRegion Select S address Selection Address ReferenceStyle xlR1Cl 100 Sheets str amp Pivot Select Cells 4 1 Activate ActiveSheet PivotTableWizard SourceType xlDatabase SourceData in amp str Y Data amp s address If str YOS PG Then ActiveSheet PivotTables PivotTablel PivotFields rule CurrentPage M ActiveSheet PivotTables PivotTablel PivotFields yr CurrentPage 1 End If ActiveSheet PivotTables 1 RefreshTable End Sub Public Sub KillCmdBar On Error Resume Next Application CommandBars New Data Delete On Error GoTo 0 End Sub Sub XportMods Dim mdl As Variant strFile As String strExt As String For Each mdl In Application VBE ActiveVBProject VBComponents strFile bas If Left mdl Name 5 Form Then strFile cls strFile Mid ActiveWorkbook Name Len ActiveWorkbook Name 7 4 strFile If Left mdl Name 5 lt gt Chart And Left mdl Name 5 lt gt Sheet _ Or Left mdl Name 6 Sheet4 _ Or Left mdl Name 6 Sheet6 Then _ mdl Export ActiveWo
73. mporary queries For each year and paygrade the target number and actual resulting count is calculated by the first query The second query calculates average number of months to promo tion by paygrade for those promoted in that year These two que ries are combined and loaded into AllYrs At the completion of the final year of the run the Likelihood and Expected tables are created The first step in this process is to dy namically build an SOL statement based on the Number of Years which creates a temporary table adding promotion results to the data for each paygrade years of service cohort in the Yr0 table This table has individual level longitudinal records Next a dy namically built SOL statement based on the Number of Years cre ates a new data structure and calculates counts and yearly averages by cohort in Likelihood Another one calculates the overall likeli hood of promotion Expected is created in the same manner but uses only those records where there has been a promotion at some point Only the FIRST promotion for an individual is considered for the Likelihood table At the end of each run the data tables are renamed and exported to Excel for further processing by PIAPM xls PIAPM mdb the PIAP model PIAPM mdb contains four linked tables five forms one macro the same AutoExec as in Yr0 mdb described above and six code mod ules The linked tables Yr0 AttrRates OccRollup and PGRollup are link
74. n AutoFi l Worksheets End If Application Scree End Sub Private Sub cboLikYOS Application Scree If Not blnDisable Worksheets ActiveSheet Cells 1 1 Select Selection AutoFi l Worksheets End If Creatable PredeclaredId True Fals True Programming by Robert W Shuford CNA Option Explicit Private Sub cboLikPG Change ike nUpdating False Events Then ihood Data Activate ike Iter Field 3 Criterial CInt cboLikPG Value ihood Chart Activate ike nUpdating True Change nUpdating False Events Then ihood Data Activate ike Iter Field 4 Criterial CInt cboLikYOS Value ihood Chart Activate Application ScreenUpdating True End Sub 111 Sheet6 VERSION 1 0 CLASS BEGIN MultiUse 1 True END Attribute VB Name Sheet6 Attribute VB GlobalNameSpace Fals Attribute VB Creatable Fals Attribute VB PredeclaredId Tru Attribute VB Exposed True Programming by Robert W Shuford CNA Option Private Explicit Sub cboPG Change End Sub 112 If Not blnDisableEvents Then Sheets TIS Pivot PivotTables PivotTablel PivotFields pg CurrentPage _ CInt cboPG Value References 1 BUPERSINST 1430 16F Advancement Manual 2 November 2007 2 MILPERSMAN 1160 120 High Year Tenure 20 October 2005 3 NAVPERS 18068F Manual Of Navy Enlisted M
75. nd of its runs and should its projected size exceed the limit it warns the user at each of these points with increasingly urgent and apocalyptic messages on the Warning form Inexplicably Access itself provides no such warnings it sim ply continues to add data until it stops functioning dl Recall that attrition rates are based on rating paygrade and years of service so the effect may be for example to reduce the rate for a sailor in his tenth year from 20 percent to 16 percent and to reduce the rate for a sailor in his eleventh year from 5 percent to 4 5 percent However since these are linear transformations the seniority profile of the E5s will not affect the overall change in attrition 15 Figure 6 Database exceeds 1 Gb H3 Warning Figure 7 Database exceeds 1 5 Gb and is projected to fail 16 PIAP data processor PIAPM xIs The Excel workbook PIAPM xls is the driver for 1 importing the spreadsheets that were output by the PIAP model 2 processing the data 3 resetting the pivot tables charts and control objects and 4 creating the sensitivity data This file must be in the same directory as PIAPM mdb and the Runs subdirectories containing the new data When the file opens it creates a new toolbar at the bottom left of the window with three buttons captioned Import New Data Compile Multiple Files and Sensitivity Data When the file closes this toolbar is destroyed The driver compiles
76. ntRegion Select Selection Copy ws l Activate Cells ELastCell ActiveSheet Row 1 1 Select ActiveSheet Paste Application CutCopyMode End Sub Public Sub FilterLikely Optional shift Sheets Likelihood Data Activate Selection CurrentRegion Select Sort by rating rule pg Selection Sort Keyl Range B2 Order2 xlAscending Key3 R xlGuess OrderCustom 1 Match Selection AutoFilter Selection AutoFilter Field 3 Selection AutoFilter Field 4 Cells 1 1 Select End Sub Private Sub GetNewData dat As String Dim s address As String Set ws 1l ActiveWorkbook Sheets d ws l Activate Range Cells 1 1 Cells SpecialCe False Cr EXT As Byte 0 ws_l Activate Orderl xlAscending Key2 Range C2 ange D2 Order3 xlAscending Case False Orientation xlTopToBottom lls 2 ls 2 3 Value2 4 Value2 iterial Cel terial Cell at amp Data lls xlLastCell ClearContents Workbooks OpenText Filename Activ amp NV 6 run e A 6 dat amp Cells 1 1 CurrentRegion Select Selection Copy ws l Activate Cells 1 1 Select ActiveSheet Paste Application CutCopyMode False Workbooks dat amp xls Close Fals Sheets dat amp Chart Select NoPivot Set ws 1l End Sub Private Function Metadata Dim s address As String Set ws 1l ActiveWorkbook Sheets ws l Activate
77. or selecting paygrade and years of service cohort a HE pzm The Likelihood chart differs from all of the other outputs in that it deals only with the current inventory The model tracks the indi viduals in the YrO table through the years and finds their first pro motion In this example we see that of our initial E5 cohort with 6 years of service 44 percent promoted to E6 in the first year 20 per cent in the second and 26 percent in the third using the Junior Rule Under the Senior Rule none promoted in the first year 60 percent in the second and 28 percent in the third Compiling multiple runs Sensitivity data In order to smooth out the results and reduce the variation that will occur among the individual runs they should be compiled into a single file and averaged The resulting file is named Com piled rating runs Files years Years xls It contains the same charts and data as the files for the individual runs but it also has statistics for minimums maximums and standard deviations As previously noted PIAPM xls is fully functional under Excel 2003 however a particular setting may need to be adjusted to allow the Sensitivity program to run On the Menu Bar under Tools Macro Security the user should click on the Trusted Pub lishers tab and check the Trust access to Visual Basic Project checkbox This security feature is disabled by default in Excel 2003 To produce a new file in order to examine t
78. other error get out with return value of False CopyModule False Exit Function End If End If End If MOMO VO Do the Export and Import operation using FName and then Kill FName MOMO A FromVBProject VBComponents ModuleName Export Filename FName ToVBProject VBComponents Import Filename FName Kill FName CopyModule True On Error GoTo 0 Function AddProcedureToModule Dim VBProj As VBIDE VBProject Dim VBComp As VBIDE VBComponent Dim CodeMod As VBIDE CodeModule Set VBProj ActiveWorkbook VBProject Set VBComp VBProj VBComponents ThisWorkbook Set CodeMod VBComp CodeModule NewModLine CodeMod Private Sub Workbook Open 105 NewModLine CodeMod On Error GoTo BarExists NewModLine CodeMod Dim i As Byte NewModLine CodeMod Application CommandBars Add Robust msoBarRight True amp Visible True NewModLine CodeMod Application CommandBars Robust _ amp Controls Add Type msoControlButton id 2950 Before 1 NewModLine CodeMod With Application CommandBars Robust _ amp Controls 1 NewModLine CodeMod style msoButtonCaption NewModLine CodeMod Caption Open Chart Form NewModLine CodeMod OnAction ThisWorkbook OpenForm NewModLine CodeMod End With NewModLine CodeMod BarExists NewModLine CodeMod End Sub NewModLine CodeMod Private Sub OpenForm NewModLine CodeMo
79. ow many E8s do we need to promote lngNeed E9s bytYr Loop through paygrades For i 8 To 3 Step 1 lngNeed ENs lngNeed i bytYr rule Next Create yearly tables for individual data SQL UPDATE Yr 6 bytYr 1 amp SE amp WHERE Yr 6 bytYr 1 prom mnths 0 SOL UPDATE Yr amp bytYr 1 amp SET Yr 6 bytYr 1 target amp lngTarget 3 amp WHERE Yr bytYr 1 pg 3 Update Shortage table SOL INSERT INTO Shortage rate rule yr pg cnt target amp shortage SELECT Yr 6 bytYr 1 amp rate AS rate strRule rule 6 AS rule amp bytYr 1 amp AS yr Yr bytYr 1 amp pg Count Yr 6 bytYr 1 ssn AS cnt Yr bytYr 1 amp target Yr amp bytYr 1 amp target Count Yr bytYr 1 amp ssn AS shortage FROM Yr amp bytYr 1 _ w GROUP BY Yr amp bytYr 1 amp rate Yr amp bytYr 1 amp pg Yr _ amp bytYr 1 amp target Update TIS TIG table SQL INSERT INTO TISTIG rate rule yr pg cnt TIS _ amp TIG SELECT Yr bytYr 1 amp rate AS rate _ amp strRule rule amp AS rule bytYr 1 AS yr Yr amp bytYr 1 amp pg Count Yr 6 bytYr L ssn AS cnt m BI HSI Yr amp bytYr 1 amp prom mn
80. pivot tables behind the charts For a more in depth analysis the user can access the yearly tables in PIAPM mdb and examine the data at the individual level The model is user configurable The PIAP model was designed to be versatile and scalable The programming code modules for Yr0 mdb PIAPM mdb and PIAPM xls are unprotected and available to the user for additions and adjustments If the user wishes to substitute updated source data he she should provide it in the format described earlier for SourceData mdb and prepare it for the model using the macros in Yr0 mdb Due to the change in the Navy s E5 High Year Tenure rules and their grandfathering of older sailors there is a line in the Main module of PIAPM mdb that must be changed The line is near the top of the module in the Global Variables section above the Main subroutine The line is Months since 7 1 2005 to 10 1 2007 our current data Const E5ADJ 27 and must be changed to reflect the number of elapsed months since July 2005 the beginning of the grandfather clause 31 32 This page intentionally left blank Appendix A Yr0 mdb programming code Table of contents MakeData Function Make vr Private Function GetHighPGRatios Function DistributeHighPGs Function MakeRealYrO Private Sub GetPGRateCount Private Sub Attrition Function RefreshLinks Private Function GetTableName Private Function HigherPath Sub XportMods 33 MakeData Attribute V
81. re ment on the Increase Decrease Person nel form by the same amount Entering a decimal e g 1 to increase by 10 per cent in the second text box will do the same on a percentage basis Enter a negative number to effect an equivalent decrease in accessions If there are val ues in both text boxes the first box will be used Choosing 1 Time Change causes this increase to be applied to the first year only choosing Permanent Step Change applies the increased accessions to each year and choosing Constant Rate of Change will increase the accessions by this number or percentage in each year com pounding the change in the case of a percentage change Clicking the Use These button opens the Increase Decrease Per sonnel Manpower Targets form 13 Increase Decrease Manpower Targets form Figure 5 Increase Decrease Manpower Targets form E Increase Decrease Manpower Targets Form This form allows the user to alter the manpower requirements promotion rules and attrition rates The first row of this matrix al lows the user to enter an annual change in requirements for each paygrade and the fourth row denotes the year in which the in crease decrease will end For example if there are currently 100 E5s and the user enters 10 in the first row of the E5 column and 5 in the fourth row the requirements will be 110 in the first year 120 in the second and so on In the fifth year and beyond the require ments will be 15
82. rk Time to Promotion Junior Benchmark and Senior Promotion Rules UU Note the bars for E6s in the second year that extend below the 0 months line This is not of course negative months these times are relative to that of the Junior Rule In this case the Junior Rule yielded a mean of 142 months to E6 130 months for the Bench mark Rule and 105 months for the Senior Rule How can promoting older sailors result in a lower mean time to promotion than promoting younger sailors This seeming anomaly sometimes results in the out years In the first year under the Junior Rule all of the younger sailors are promoted leaving the older ones and those not yet eligible Likewise using the Senior Rule all of the older sailors are promoted leaving the younger ones and those not yet eligible If there are relatively few E5s that become eligible for promotion in the next year the reservoir of older sailors previ 16 12 relative to the Junior Rule 17 37 relative to the Junior Rule 25 26 ously passed over using the Junior Rule must be promoted increas ing the average Time in Service Again likewise all of the younger sailors previously passed over using the Senior Rule must be pro moted decreasing the average Time in Service Figure 15 Likelihood chart Dropdowmboxes f
83. rkbook Path s Modules Excel mdl Name amp strFile strFile bas If Left mdl Name 5 Form Then strFile cls If Left mdl Name 5 lt gt Chart And Left mdl Name 5 lt gt Sheet _ Or Left mdl Name 6 Sheet4 _ Or Left mdl Name 6 Sheet6 Then mdl Export ActiveWorkbook Path s Modules Excel mdl Name amp strFile Next Set mdl Nothing End Sub Function EMax As Double Dim rngRange As Range rngMax As Range c As Range Dim dblMaxVal As Double Set rngRange Selection dblMaxVal 1 79769313486231E 308 Set rngMax ActiveCell 101 For Each c In rngRange If Not IsEmpty c Value And Not IsError c Value And IsNumeric c Value Or IsDate c Value Then If c Value dblMaxVal Then dblMaxVal c Value Set rngMax c End If End If Next EMax dblMaxVal Set rngRange Nothing Set rngMax Nothing Set c Nothing End Function Public Sub KillcCharts Dim i As Integer For i ActiveSheet ChartObjects Count To 1 Step 1 ActiveSheet ChartObjects i Delete Next nd Sub unction GetRating As String Extracts the rating from the data files in the current directory With Application FileSearch 4 nj pj NewSearch LookIn ActiveWorkbook Path amp uW Filename Likelihood xls If Execute 0 Then GetRating Mid GetTableName FoundFiles 1 11 GetRating Left GetRating Len GetRat
84. rrCnt Case 2 By percentage in occ array CalcByoptPers Round lngOccCount 0 promotions As Long As Long 1 sngIntDecPers 0 yrnum 1 lngTarget 3 lngCurrCnt Case 3 By number as global value CalcByoptPers Round yrnum sngPers 50 0 cnt As Long NewAccess Maximum CalcByoptPers 1 lngCurrCnt lngTarget 3 NewAccess Case 4 By percentage as gl lng CalcByoptPers Case Els e lng CalcByoptPers End Function set rsl With rs1 End Select MoveFirst rsl SumOfprob sep Pred End With Set rsl End Function Nothing IngTarget 3 Private Function Pred As Single Dim rsl As DAO Recordset CurrentDb OpenRecordset S Target 3 lngCurrCnt lobal value Round 1ngO0ccCount 0 1 sngPers Target 3 lngCurrCnt lngCurrCnt EL ECT Sum temp prob sep yrnum 1 0 AS SumOfprob sep FROM temp 51 Preliminaries Attribute VB Name Preliminarie Programming by Robert W Shuford Option Compare Database Option Explicit Sub End Sub End End End 52 MakeGuysTable SQL SELECT Yr0 ssn Yr0 pg amp WHERE Yr0 rate v Sub MakeTables MakeYOS_PGTable MakeSepTable MakeShortTable MakePromTable MakeTISTIGTable Sub Private Sub MakeSepTable Dim tdf As TableDef
85. rs True GapWidth 150 End With ChartGroups 1 UpBars Select 97 On BoxErr End 98 Sub Dim With ActiveChart With Selection Border Weight xlMedium LineStyle xlContinuous End With With Selection Interior ColorIndex 15 PatternColorIndex 1 Pattern xlSolid End With Legend Select Selection Delete EBoxPlotFormat End With Exit Sub Error GoTo 0 Private Sub EBoxPlotFormat sc As Integer lb As Integer ub As Integer i As Integer sc SeriesCollection Count lb Int sc 2 ub Int sc 2 1 sc Mod 2 Series outside of box For i 1 To lb 1 EOutliers i Next For i ub 1 To sc EOutliers i Next Median If ub lb 2 Then EOutliers lb 1 3 xlDash 10 Box ESeriesOrder lb 1 ESeriesOrder ub sc End With Range A1 Activate End Sub Private Sub E0utliers series As Integer Optional color As Byte 1 _ Optional style As Integer xlCircle Optional size As Byte 5 ActiveChart SeriesCollection series Select Selection Border LineStyle xlNone With Selection End End Sub Private MarkerBackgroundColorIndex color MarkerForegroundColorIndex color MarkerStyle styl MarkerSize siz With Sub ESeriesOrder series As Integer order As Integer ActiveChart ChartGroups 1 SeriesCollection series Select Selection
86. t i 1 sngIntDec oc i Next Case 2 By number For i 3 To 9 If yr lt bytStopYr i sngIntDec oc i Next Case Else End Select End Sub Get number in each occ Function GetOccCount Dim i As Byte Load into lngOccCount array SQL SELECT RateRollup rate As Long Then lngTarget i RateRollup cnt Round 1ngTarget i 3 0 lngTarget i 3 u amp INTO temp FROM RateRollup amp ORDER BY RateRollup rate Set rs CurrentDb OpenRecordset temp ReDim lngOccCount rs RecordCount 1 ReDim strOccArray rs RecordCount 1 rs MoveFirst For i 0 To UBound strOccArray strOccArray i rs Rate lngOccCount i rs cnt GetUcclount rs MoveNext Next set rs End Function Get separation rate for new accessions Function GetNewGuySepRate As Single Dim i As Byte Nothing number in Create temp table with th DoCmd RunSQL amp AttrRates rate amp AND AttrRates yos 0 GetOccCount lngOccCount i ach occ SELECT AttrRates prob sep INTO temp FROM AttrRates WHERE amp strOcc amp AND uuu AttrRates pg 3 Set rs CurrentDb OpenRecordset temp 56 rs MoveFirst GetNewGuySepRate rs prob sep Set rs Nothing End Function Stats Attribute VB Name Stats Programming by Robert W Shuford CNA Option Compare Database Option Explicit
87. te Dim fso Set fso CreateObject Scripting FileSystemObject On Error Resume Next fso DeleteFile CurrentProject Path NExpected 6 occrule amp xls fso DeleteFile CurrentProject Path amp Likelihood 6 occrule xls On Error GoTo 0 For i 1 To NumYrs Set qdf CurrentDb CreateQueryDef tmpOry _ SELECT Yr 6 i 6 rate 6 Right occrule 1 amp as rule Yr 6 i pg 6 i 6 as yr Count Yr amp i amp prom mnths AS cnt Avg Yr amp i s prom mnths AS AvgOfprom mnths INTO EYr _ amp i amp FROM Yr i GROUP BY Yr amp i 6 rate Yr amp i _ amp pg HAVING Count Yr amp i amp prom mnths Is Not Null DoCmd OpenQuery tmpqry acNormal acEdit DoCmd TransferSpreadsheet acExport 8 EYr amp i CurrentProject Path amp N 6 Run 6 NExpected amp occrule xls True DoCmd DeleteObject acQuery tmpQry DoCmd TransferSpreadsheet acExport 8 Likelihood CurrentProject Path _ Next amp Set fso Set qdf End Sub N 6 Run Likelihood amp occrule amp xls True Nothing Nothing 61 Utilities Attribute VB Name Utilities Programming by Robert W Shuford CNA Option Compare Database Option Explicit Minor Subs amp Utilities Sub ResetSeed Randomize nd Sub Delete individual Sub KillTables Di year
88. the data exported by PIAPM mdb to produce datasheets pivot tables and charts depicting e Mean Time in Service and Time in Grade e Percentage of individuals in each paygrade who promote e Gaps between manpower and requirements e Attrition rates Time to Promotion ranges achievable under the current promotion requirements and personnel profile e Likelihood of promotion in each year for the individuals in the current inventory Each of these metrics can be examined as year by year trends by paygrade and under any of our assumed promotion rules The pro gramming for PIAPM xls is in appendix C 17 18 Using the driver PIAPM xls contains templates for receiving the newly imported data and these templates are updated to handle the configuration of the variably structured data in terms of years and the number of runs that the user entered in the PIAP model Figure 8 Import Compile and Sensitivity buttons El pa Em ge pee fue Des Dun dure mp adde mr FAA A nee nu TRS OMO4r X A gt Bea RA Li ILC s 5 t 7 y R E J A zza RR SZU UUTUNNUSZ cn we seas L d P wo 0 50 Import New Data Compile Multiple Fies Sensitivity Data gend Zem reme je When the user clicks the Import New Data button he she is prompted to enter the number of runs that the model had executed to produce the outputs and the driver will import from each of the subdirectories up to this number After importing an
89. ths Null 44 End Sub Handle E9s separately since they don t Private Function s Avg Yr bytYr 1 amp s Avg Yr bytYr 1 amp amp FROM Yr 6 bytYr 1 _ amp GROUP BY Yr amp bytYr Update YOS PG table SOL INSERT INTO YOS PG rate strOcc amp AS rate strRule rule amp AS bytYr 1 amp pg Yr bytYr 1 amp ssn AS GROUP BY Yr amp bytYr E m VI Gi m Next Create AllYrs CompileData MaxYear Prepare data for Likelihood and GetDataForProbs MaxYear Create Likelihood and Expected tabl CalcProbs MaxYear strRule rule DoCmd DeleteObject acTable temp Exp E9s yr As Byte Create temp table with E9 data for SQL SELECT Yr 6 yr amp ssn Yr amp amp Yr amp yr amp months Yr amp yr amp yos Yr amp yr amp m O AS prom mnths lngT INTO temp FROM Yr amp yr amp ON Yr amp yr yos At AND Yr amp yr amp rate AND Yr amp yr amp pg At D WHERE Yr amp yr amp rate AND Yr amp yr amp pg 9 amp ORDER BY Yr amp yr amp mon Change attrition rates SQL UPDATE temp SET temp prob sep m mm mmm amp WHERE prob sep lt gt 1 Separate guys E9Sep yr Calculate needs E9s lngTarget 9 rs RecordCount Set rs Nothing
90. ts box will leave just the new chart making the file size much smaller while leaving it unchecked makes it possible to create a large number of charts for examination or for copying and pasting into another application The user must close the form to examine another sheet Since the form is context sensitive in the sense that its controls depend on which worksheet is active when the Open Chart button is clicked it is created as modal so the 18 A modal form or window requires the user to take some action before continuing It may be operating system wide i e not allowing the user to use any application or it may be specific to a particular application 28 user cannot do anything else in Excel while the form is open oth erwise errors may occur If the user wishes to change this behavior and is familiar with Visual Basic for Applications VBA or some other integrated development environment IDE he she can set the form s ShowModal property to False in the Visual Basic Editor Figure 17 Open Chart Form button 29 04 0 35 0 3 0 25 0 2 0 15 0 1 0 05 Figure 18 Robustness of promotion rates PG4 Show Chart 30 The charts produced by PIAPM xls provide a quick graphical glimpse into the data output by the PIAP model but a thorough analysis requires a rich dataset As such the data behind the charts are provided and transparent for both the compiled outputs and on the individual run level as are the
91. ub Robustness Private Sub ShortSepTIS Private Sub MakeCharts 71 Public Function MakeChart Public Sub LikChart Sub EMakeBoxPlot Private Sub EBoxPlotFormat Private Sub EOutliers Private Sub ESeriesOrder Private Sub Kill YrO Utilities Public Function ELastCell Public Sub RefreshPivot Public Sub KillCmdBar Sub XportMods Function EMax Public Sub KillCharts Function GetRating Private Function GetTableName Function CopyModule Sub AddProcedureToModule Private Sub NewModLine Sub AddReference Sub ListReferencePaths Choice form Private Sub UserForm Private Sub cmdChart Private Sub spnYOS Private Sub txtYOS Private Function WhichData Workbook Private Sub Workbook Private Sub NewButton Private Sub Workbook Sheet4 Private Sub cboLikPG Private Sub cboLikYOS Sheet6 Private Sub cboPG T4 Main Attribute VB Name Main Programming by Robert W Shuford CNA Option Explicit Dim Dim Sub rating As String yr As Byte rule As Variant run As Byte ws t As Worksheet ws l As Worksheet wb As Workbook LoopDirs Dim i As Byte Application ScreenUpdating False For i 1 To 10 CompileData i Next Application ScreenUpdating True Sub CompileData numrun As Byte Dim yrs As Byte strPath As String rate As String strPath ActiveWorkbook Path Set ws t ActiveWorkbook Sheets TIS Data Set ws_l ActiveWorkbook Sheets Likelihood Data run numrun Del
92. vot Select Selection Copy Sheets str Select Selection PasteSpecial Paste xlValues Operation xlNone SkipBlanks _ False Transpose False Rows 1 1 Select App lication CutCopyMode False Selection Delete shift xlUp illBadRow col Ki FILL Cols col 1 Cell s Replace What Average of Replacement LookAt xlPart SearchOrder xlByRows MatchCase False ActiveCell CurrentRegion Columns AutoFit Cel s 1 1 Select If str Likelihood Then Cells 1 3 Value2 yos If str End End Sub Private Dim For Next End Sub Private Dim Move YOS PG Then Range F F H H J J L L Select Selection Delete shift xlToLeft Range Al Select If Data str Sub KillBadRow c As Byte R As Integer R ELastCell ActiveSheet Row To 1 Step 1 If Cells R c Value2 Then Rows R EntireRow Select Selection Delete shift xlUp End If Sub FillCols col As Byte R As Integer c As Byte intLastRow intLastRow ELastCell ActiveSheet Row For c e L To col For R 1 To intLastRow Cells R c Activate If ActiveCell Value2 Then ActiveSheet Paste ActiveCell Copy 85 Next Next End Sub Private Sub MoveData str As String wbDriver Sheets str amp Data Activate ActiveSheet AutoFilterMode Fals Range Cells 1 1 Cells SpecialCells xlL
93. x End Sub 68 MsgBox Choose a Type of Year to Year Change r r 1 acNormal Not So Fast Hang On wu wu My Friend acNormal Manpower form VERSION 1 0 CLASS BEGIN MultiUse 1 kk END Attribute VB Name Attribute VB GlobalNameSpace rue Form Increase Decrease Manpower Targets Attribute VB Creatable Tru False Attribute VB PredeclaredId True Attribute VB Exposed False Programming by Robert W Option Compare Database Option Explicit Private Sub cmdUse Click Dim varReturn Exit Sub NoType End Sub As Variant If IsNull framPctNum Va optType framPctNum Val DoCmd SelectObject acForm Public Sub AssignMan Dim i As Byte j As Byte optManChange frmChange For j 3 To 8 sngIntDec i j 3 min tis j 1 min tig j 1 sngLossChange j Eo bytStopYr j If bytStopYr 3 Next sngLossChange 9 bytStopYr 9 If bytStopYr 9 min_tis 8 40 min_tig 8 40 End Sub Control 0 0 lue Then Gol lue Shuford CNA o NoType Controller False MsgBox Choose a Type of Increase Decrease Hang On varReturn SysCmd acSysCmdClearStatus Controls Item txt amp i amp j Controls Item txtl amp j 1 Controls Item txt2 6 j 1 Controls Item txt3 amp 3 ntrols Item txt4 j 0 Then bytStopYr j 100 Is Item
94. xt ActiveCell Value2 Year ActiveCell Offset 1 0 Select For o 4 To 9 For i 1 To numyrs ActiveCell Value2 y 6 i ActiveCell Offset 1 0 Select Next ActiveCell Offset 1 0 Select Next Cells 2 1 Value2 E4 For o 5 To 9 Cells o 4 numyrs 1 2 1 Value2 E amp o Next For o 4 To 9 Cells o 4 numyrs 1 2 2 Select For i 1 To numyrs ActiveCell FormulaR1C1 TIS Pivot R amp o 2 C amp 4 i 2 ActiveCell Offset 0 1 FormulaR1C1 TIS Pivot R amp o 2 _ C amp 4 i 1 amp TIS Pivot IR E o 286 C 6 4 i 2 ActiveCell Offset 0 2 FormulaR1C1 IF s ActiveCell Offset 0 1 Address ReferenceStyle x1R1C1 _ amp gt 0 TIS Pivot R amp o 2 C 4 i TIS Pivot R Sot 286 C 6 4 i 1 6 TIS Pivot R o 2 6 C 6 4 i _ 90 amp TIS ActiveCell Offset Next Next ActiveCell Offset 1 1 Pivot R Sot 2 amp C 4 i 2 amp 1 3 Select Select SetSrc numyrs End Sub Private Sub SetSrc yrs As Byte Dim rng As Range i As Byte ActiveWorkbook Sheets TI S Activate 11 Cells 1 1 Set rng Range ActiveCe ActiveWorkbook Sheets TI ActiveSheet ChartObjects ActiveChart ChartArea Sel ActiveChart SetSourceData For i 1 To ActiveChart ActiveChart

User Manual for Personnel Inventory Aging and Promotion Model

Contents

Download Pdf Manuals

Related Search

Related Contents