User:Bt04b036/sandbox

Option Explicit

Private Sub cmdGroup_Click Application.ScreenUpdating = False Inp0Button.Range("B10").Value = 0 Dim cntVar, cntFmt As Integer 'CHECK IF VARIABLES ARE LOADED var.Visible = xlSheetVisible var.Activate cntVar = WorksheetFunction.CountA(var.Range("A:A")) If cntVar < 2 Then MsgBox "Load variables before opening the form", vbOKOnly + vbCritical Inp0Button.Activate var.Visible = xlSheetHidden Exit Sub End If   var.Visible = xlSheetHidden 'CHECK IF FORMATS ARE LOADED fmt.Visible = xlSheetVisible fmt.Activate cntFmt = WorksheetFunction.CountA(fmt.Range("A:A")) If cntFmt < 2 Then MsgBox "Formats are not loaded", vbOKOnly End If   Inp0Button.Activate fmt.Visible = xlSheetHidden frmGroupView.Show End Sub

Private Sub cmdGroupBack_Click If Inp0Button.Range("B10").Value = 1 Then 'Inp0Button.Range("F10:I11").Interior.ColorIndex = xlNone 'Inp0Button.Range("F10:I11").Font.ColorIndex = 2 frmGroupView.Show End If End Sub

Private Sub cmdSuite_Click Application.ScreenUpdating = False If Inp1GDS.Range("A2").Value = "" Then MsgBox "Complete filling the Group Details form first", vbOKOnly + vbCritical frmGlobalForm.Hide Unload frmGlobalForm Exit Sub End If   frmGlobalForm.Show End Sub

Private Sub cmdVariables_Click Call getInfo.getVars End Sub

Private Sub cmdFormats_Click Call getInfo.getFmts End Sub

"getInfo 'GET VARIABLES Sub getVars Application.ScreenUpdating = False   Dim thisWB, filePath, fileName As String    thisWB = ThisWorkbook.Name    filePath = Application.GetOpenFilename    'CHECK IF FILE EXTENSION IS CORRECT    If checkExtension(filePath) = True Then        Workbooks.Open fileName:=filePath        'CHECK IF FILE IS CORRECT        If (Range("A1").Value <> "NAME" Or Range("B1").Value <> "LABEL" Or Range("C1").Value <> "TYPE") Then            MsgBox "File doesn't have required fields", vbOKOnly + vbCritical            ActiveWorkbook.Close            Exit Sub        End If        Range("A1:C1").Select        fileName = ActiveWorkbook.Name        cntCase = WorksheetFunction.CountA(ActiveSheet.Range("A:A"))

Range(Selection, Selection.End(xlDown)).Select Selection.Copy Windows(thisWB).Activate var.Visible = xlSheetVisible var.Select ActiveSheet.Paste Application.CutCopyMode = False Range("A1").Select 'DELETE PREVIUOS VARIABLES IF ANY var.Range("A" & cntCase + 1 & ":C2500").ClearContents 'cntCase = WorksheetFunction.CountA(var.Range("A:A")) For i = 2 To cntCase var.Cells(i, 1).Value = UCase(var.Cells(i, 1).Value) Next i       Inp0Button.Select var.Visible = xlSheetHidden Windows(fileName).Activate ActiveWorkbook.Close Else Exit Sub End If End Sub

'GET FORMATS Sub getFmts Application.ScreenUpdating = False Dim thisWB, filePath, fileName As String thisWB = ThisWorkbook.Name filePath = Application.GetOpenFilename 'CHECK IF FILE EXTENSION IS CORRECT If checkExtension(filePath) = True Then Workbooks.Open fileName:=filePath 'CHECK IF FILE IS CORRECT If (Range("A1").Value <> "FMTNAME" Or Range("B1").Value <> "START" Or Range("C1").Value <> "END") Then MsgBox "File doesn't have required fields", vbOKOnly + vbCritical ActiveWorkbook.Close Exit Sub End If       Range("A1:G1").Select fileName = ActiveWorkbook.Name cntCase = WorksheetFunction.CountA(ActiveSheet.Range("A:A")) Range(Selection, Selection.End(xlDown)).Select Selection.Copy Windows(thisWB).Activate fmt.Visible = xlSheetVisible fmt.Select ActiveSheet.Paste Application.CutCopyMode = False Range("A1").Select 'DELETE PREVIUOS VARIABLES IF ANY fmt.Range("A" & cntCase + 1 & ":G50000").ClearContents cntCase = WorksheetFunction.CountA(fmt.Range("A:A")) For i = 2 To cntCase fmt.Cells(i, 1).Value = UCase(fmt.Cells(i, 1).Value) fmt.Cells(i, 4).FormulaR1C1 = "=""[""&RC[-2]&""-""&RC[-1]&""]""" Next i       'DELETE ROWS WITH **OTHERS** Call getInfo.deleteOthers Range("A1").Select Inp0Button.Select fmt.Visible = xlSheetHidden Windows(fileName).Activate ActiveWorkbook.Close Else Exit Sub End If End Sub

'CHECK FILE EXTENSION Function checkExtension(ByVal fileExt As String) As Boolean checkExtension = True checkString = "" & LCase(Right(fileExt, 4)) If Not (checkString = ".csv" Or checkString = ".xls" Or checkString = "xlsx") Then MsgBox "Invalid filetype", vbInformation + vbOKOnly checkExtension = False Exit Function End If End Function

'DELETE ROWS WITH **OTHER** FORMAT Sub deleteOthers Dim lRow As Integer lRow = WorksheetFunction.CountA(fmt.Range("A:A")) 'CLEAR ROWS WITH **OTHER** For i = 2 To lRow If UCase(fmt.Cells(i, 2).Value) = "**OTHER**" Then Rows(i).Select Selection.ClearContents End If Next i

lRowAgain = WorksheetFunction.CountA(fmt.Range("A:A")) 'DELETE BLANK ROWS For j = 2 To lRowAgain If WorksheetFunction.CountA(Rows(j)) = (0 Or Empty) Then Rows(j).Select Application.CutCopyMode = False Selection.Delete Shift:=xlUp j = j - 1 End If Next j

End Sub

"mCRC Option Explicit Option Compare Text

'// Then declare this array variable Crc32Table Private Crc32Table(255) As Long

'// Then all we have to do is write public functions like 'these... Public Function InitCrc32(Optional ByVal Seed As Long = _  &HEDB88320, Optional ByVal Precondition As _   Long = &HFFFFFFFF) As Long

'// Declare counter variable iBytes, 'counter variable iBits, 'value variables lCrc32 and lTempCrc32 Dim iBytes As Integer, iBits As Integer, lCrc32 As Long Dim lTempCrc32 As Long

'// Turn on error trapping On Error Resume Next

'// Iterate 256 times For iBytes = 0 To 255

'// Initiate lCrc32 to counter variable lCrc32 = iBytes

'// Now iterate through each bit in counter byte For iBits = 0 To 7 '// Right shift unsigned long 1 bit lTempCrc32 = lCrc32 And &HFFFFFFFE lTempCrc32 = lTempCrc32 \ &H2 lTempCrc32 = lTempCrc32 And &H7FFFFFFF

'// Now check if temporary is less than zero and then 'mix Crc32 checksum with Seed value If (lCrc32 And &H1) <> 0 Then lCrc32 = lTempCrc32 Xor Seed Else lCrc32 = lTempCrc32 End If     Next

'// Put Crc32 checksum value in the holding array Crc32Table(iBytes) = lCrc32 Next

'// After this is done, set function value to the 'precondition value InitCrc32 = Precondition

End Function

'// The function above is the initializing function, now 'we have to write the computation function Public Function AddCrc32(ByVal Item As String, _ ByVal Crc32 As Long) As Long

'// Declare following variables Dim bCharValue As Byte, iCounter As Integer, lIndex As Long Dim lAccValue As Long, lTableValue As Long

'// Turn on error trapping On Error Resume Next

'// Iterate through the string that is to be checksum-computed For iCounter = 1 To Len(Item)

'// Get ASCII value for the current character bCharValue = Asc(Mid$(Item, iCounter, 1))

'// Right shift an Unsigned Long 8 bits lAccValue = Crc32 And &HFFFFFF00 lAccValue = lAccValue \ &H100 lAccValue = lAccValue And &HFFFFFF

'// Now select the right adding value from the 'holding table lIndex = Crc32 And &HFF lIndex = lIndex Xor bCharValue lTableValue = Crc32Table(lIndex)

'// Then mix new Crc32 value with previous 'accumulated Crc32 value Crc32 = lAccValue Xor lTableValue Next

'// Set function value the the new Crc32 checksum AddCrc32 = Crc32

End Function

'// At last, we have to write a function so that we 'can get the Crc32 checksum value at any time Public Function GetCrc32(ByVal Crc32 As Long) As Long '// Turn on error trapping On Error Resume Next

'// Set function to the current Crc32 value GetCrc32 = Crc32 Xor &HFFFFFFFF

End Function

"mExecute Option Explicit

'Public Sub sbFtpTextFile(ByVal sOutTextFile As String) Public Sub sbFtpTextFile(ByVal sOutTextFile As String, ByVal nameU As String)

Dim fs As FileSystemObject Dim txsOut As TextStream sOutTextFile = Left$(sOutTextFile, InStr(1, sOutTextFile, ".") - 1) Set fs = New FileSystemObject If fs.FileExists(ThisWorkbook.Path & "\ftpcomm.txt") Then fs.DeleteFile (ThisWorkbook.Path & "\ftpcomm.txt") End If   If fs.FileExists(ThisWorkbook.Path & "\ftpcomm2.txt") Then fs.DeleteFile (ThisWorkbook.Path & "\ftpcomm2.txt") End If   Set txsOut = fs.CreateTextFile(ThisWorkbook.Path & "\ftpcomm.txt", True) txsOut.WriteLine ("open " & frmGlobalForm.txtServer) txsOut.WriteLine (frmGlobalForm.txtUserName) txsOut.WriteLine (frmGlobalForm.txtPassword) txsOut.WriteLine ("LITERAL SITE RDW LRECL=600 BLOCKSIZE=0 RECFM=FB TRACKS PRIMARY=50 SECONDARY=50") 'txsOut.WriteLine ("put """ & ThisWorkbook.Path & "\" & sOutTextFile & ".txt"" 'M51434.SMTOOL.I." & sOutTextFile & "'") txsOut.WriteLine ("put """ & ThisWorkbook.Path & "\" & sOutTextFile & ".txt"" '" & nameU & ".SMTOOL.I." & sOutTextFile & "'") txsOut.WriteLine ("close") txsOut.WriteLine ("bye") txsOut.WriteLine ("@echo off") txsOut.WriteLine ("cls") txsOut.Close Set txsOut = fs.CreateTextFile(ThisWorkbook.Path & "\ftpcomm2.txt", True) txsOut.WriteLine ("open " & frmGlobalForm.txtServer) txsOut.WriteLine (frmGlobalForm.txtUserName) txsOut.WriteLine (frmGlobalForm.txtPassword) txsOut.WriteLine ("QUOTE SITE FILETYPE=JES") txsOut.WriteLine ("put """ & ThisWorkbook.Path & "\Main.txt""") txsOut.WriteLine ("close") txsOut.WriteLine ("bye") txsOut.WriteLine ("@echo off") txsOut.WriteLine ("cls") txsOut.Close Set txsOut = fs.CreateTextFile(ThisWorkbook.Path & "\cmdftp.bat", True) txsOut.WriteLine (Left(ThisWorkbook.Path, InStr(1, ThisWorkbook.Path, ":"))) txsOut.WriteLine ("cd " & ThisWorkbook.Path) txsOut.WriteLine ("ftp -s:ftpcomm.txt") 'txsOut.WriteLine ("pause") txsOut.Close Set txsOut = fs.CreateTextFile(ThisWorkbook.Path & "\cmdftp2.bat", True) txsOut.WriteLine (Left(ThisWorkbook.Path, InStr(1, ThisWorkbook.Path, ":"))) txsOut.WriteLine ("cd " & ThisWorkbook.Path) txsOut.WriteLine ("ftp -s:ftpcomm2.txt") 'txsOut.WriteLine ("pause") txsOut.Close Call Shell(ThisWorkbook.Path & "\cmdftp.bat", vbNormalFocus) Application.Wait (Now + TimeValue("0:00:20")) Call Shell(ThisWorkbook.Path & "\cmdftp2.bat", vbNormalFocus) Application.Wait (Now + TimeValue("0:00:20")) fs.DeleteFile (ThisWorkbook.Path & "\ftpcomm.txt") fs.DeleteFile (ThisWorkbook.Path & "\cmdftp.bat") fs.DeleteFile (ThisWorkbook.Path & "\ftpcomm2.txt") fs.DeleteFile (ThisWorkbook.Path & "\cmdftp2.bat") fs.DeleteFile (ThisWorkbook.Path & "\" & sOutTextFile & ".txt") fs.DeleteFile (ThisWorkbook.Path & "\Main.txt") Set txsOut = Nothing Set fs = Nothing

End Sub

"mFill Sub fillDetails Application.ScreenUpdating = False

SheetData.Visible = xlSheetVisible Inp1GDS.Visible = xlSheetVisible Inp2GDC.Visible = xlSheetVisible

'FILL "GROUP DETAILS - SEGMENTS" TAB Inp1GDS.Select Inp1GDS.Range("A2:AQ7501").Select Selection.ClearContents SheetData.Select lstRow = WorksheetFunction.CountA(SheetData.Range("AJ:AJ")) SheetData.Range("A10:AQ7510").Select Selection.Copy Range("A1").Select Inp1GDS.Select Inp1GDS.Range("A2").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 'DELETE BLANK ROWS For i = 2 To lstRow If WorksheetFunction.CountA(Inp1GDS.Rows(i)) = (0 Or Empty) Then Inp1GDS.Rows(i).Select Application.CutCopyMode = False Selection.Delete Shift:=xlUp i = i - 1 End If   Next i    'CLEAR GARBAGE INFO Range("F2:W" & lstRow).Select Selection.ClearContents 'REARRANGE COLUMNS Range("D2:E" & lstRow).Select Selection.Cut Range("E2").Select ActiveSheet.Paste Range("AJ2:AJ" & lstRow).Select Selection.Cut Range("D2").Select ActiveSheet.Paste Range("AA2:AI" & lstRow).Select Selection.Cut Range("G2").Select ActiveSheet.Paste

Range("AK2:AO" & lstRow).Select Selection.Cut Range("P2").Select ActiveSheet.Paste

Range("X2:Z" & lstRow).Select Selection.Cut Range("U2").Select ActiveSheet.Paste

Range("AP2:AQ" & lstRow).Select Selection.Cut Range("X2").Select ActiveSheet.Paste 'FILL BLANK CELLS For j = 3 To lstRow For k = 1 To 15 If Cells(j, k).Value = "" Then Cells(j, k).Value = Cells(j - 1, k).Value End If       Next k        For l = 20 To 23 If (Cells(j, 3).Value = Cells(j - 1, 3).Value And Cells(j, 5).Value = Cells(j - 1, 5).Value And Cells(j, l).Value = "") Then Cells(j, l).Value = Cells(j - 1, l).Value End If       Next l    Next j    For a = 2 To lstRow For b = 1 To 25 If Cells(a, b).Value = "" Then Cells(a, b).Value = "NA" End If       Next b    Next a    Range("A1").Select 'FILL "GROUP DETAILS - CHARACTERISTICS" TAB Inp2GDC.Select Inp2GDC.Range("A2:AT7501").Select Selection.ClearContents SheetData.Select lstRowC = WorksheetFunction.CountA(SheetData.Range("AR:AR")) SheetData.Range("A10:AT7510").Select Selection.Copy Range("A1").Select Inp2GDC.Select Inp2GDC.Range("A2").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 'DELETE BLANK ROWS For i = 2 To lstRowC If WorksheetFunction.CountA(Rows(i)) = (0 Or Empty) Then Rows(i).Select Application.CutCopyMode = False Selection.Delete Shift:=xlUp i = i - 1 End If   Next i    'CLEAR GARBAGE INFO Range("F2:AI" & lstRowC).Select Selection.ClearContents Range("AK2:AQ" & lstRowC).Select Selection.ClearContents 'REARRANGE COLUMNS Range("D2:E" & lstRowC).Select Selection.Cut Range("E2").Select ActiveSheet.Paste Range("AJ2:AJ" & lstRowC).Select Selection.Cut Range("D2").Select ActiveSheet.Paste Range("AR2:AT" & lstRowC).Select Selection.Cut Range("G2").Select ActiveSheet.Paste

'FILL BLANK CELLS For j = 3 To lstRowC For k = 1 To 6 If Cells(j, k).Value = "" Then Cells(j, k).Value = Cells(j - 1, k).Value End If       Next k    Next j    Range("A1").Select SheetData.Visible = xlSheetHidden Inp1GDS.Visible = xlSheetHidden Inp2GDC.Visible = xlSheetHidden Inp0Button.Activate End Sub

Sub Replace_Low_High

'REPLACE LOW/HIGH IN PSI BUCKETS Inp3PSI.Visible = xlSheetVisible Inp3PSI.Activate Cells.Replace What:="LOW", Replacement:="-99999999", LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False Cells.Replace What:="HIGH", Replacement:="99999999", LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False Inp0Button.Activate Inp3PSI.Visible = xlSheetHidden

'REPLACE LOW/HIGH IN CSI BUCKETS Inp4CSI.Visible = xlSheetVisible Inp4CSI.Activate Cells.Replace What:="LOW", Replacement:="-99999999", LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False Cells.Replace What:="HIGH", Replacement:="99999999", LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False Inp0Button.Activate Inp4CSI.Visible = xlSheetHidden

End Sub

Sub Delete_Rows_Other 'PSI DETAILS Inp3PSI.Visible = xlSheetVisible Inp3PSI.Activate lstRow = WorksheetFunction.CountA(Inp3PSI.Range("A:A")) 'CLEAR ROWS WITH **OTHER** For i = 2 To lstRow If UCase(Inp3PSI.Range.Cells(i, 5).Value) = "**OTHER**" Then Rows(i).Select Selection.ClearContents End If Next i 'DELETE BLANK ROWS For i = 2 To lstRow If WorksheetFunction.CountA(Rows(i)) = (0 Or Empty) Then Rows(i).Select Application.CutCopyMode = False Selection.Delete Shift:=xlUp i = i - 1 End If Next i 'CSI DETAILS Inp4CSI.Visible = xlSheetVisible Inp4CSI.Activate lstRowC = WorksheetFunction.CountA(Inp4CSI.Range("A:A")) 'CLEAR ROWS WITH **OTHER** For j = 2 To lstRowC If UCase(Inp4CSI.Range.Cells(j, 6).Value) = "**OTHER**" Then Rows(j).Select Selection.ClearContents End If Next j 'DELETE BLANK ROWS For j = 2 To lstRowC If WorksheetFunction.CountA(Rows(j)) = (0 Or Empty) Then Rows(j).Select Application.CutCopyMode = False Selection.Delete Shift:=xlUp j = j - 1 End If Next j

Inp0Button.Activate Inp3PSI.Visible = xlSheetHidden Inp4CSI.Visible = xlSheetHidden

End Sub

"mTextFile Option Explicit

'Function fnCreateTextFile As String Function fnCreateTextFile(ByVal nameU As String, ByVal nameS As String) As String

Dim lCrc32Value As Long Dim fs As FileSystemObject Dim txsOut As TextStream Dim sOutTextFile As String sOutTextFile = GlobalForm.Range("B2").Value & ".txt" On Error GoTo 0 'Get a handle on the text file to be written Set fs = New FileSystemObject If fs.FileExists(ThisWorkbook.Path & "\" & sOutTextFile) Then fs.DeleteFile (ThisWorkbook.Path & "\" & sOutTextFile) End If   Set txsOut = fs.CreateTextFile(ThisWorkbook.Path & "\" & sOutTextFile, True) Call sbWriteGlobals(txsOut) Call sbWriteScoreSummary("Score Summary - Formula", txsOut) Call sbWriteScoreSegments("Group Detail - Segments", txsOut) Call sbWriteScoreCharacteristics("Group Detail - Characteristics", txsOut) Call sbWritePSIDetails("PSI Detail", txsOut) Call sbWriteCharDetails("Characteristic Detail", txsOut) Call sbWriteAllCharacteristics("Characteristic Detail", txsOut) txsOut.Close If fs.FileExists(ThisWorkbook.Path & "\Main.txt") Then fs.DeleteFile (ThisWorkbook.Path & "\Main.txt") End If   Set txsOut = fs.CreateTextFile(ThisWorkbook.Path & "\Main.txt", True) txsOut.WriteLine ("//#0MAIN JOB (" & GlobalForm.Range("B9").Value & ",SM),'SMTOOL',NOTIFY=&SYSUID,") txsOut.WriteLine ("//            MSGLEVEL=(1,1),MSGCLASS=T,REGION=64M,CLASS=G") 'WRITE FOR XF. DO NOT OTHERWISE (?!!) If nameS = "HCSB" Then txsOut.WriteLine ("//PRC    JCLLIB ORDER=PD00.CP000000.GLOB.PRC") End If   txsOut.WriteLine ("//SAS  EXEC PROC=SAS,WORK='3000,3000',OPTIONS=SYSPARM=" & Left$(sOutTextFile, InStr(1, sOutTextFile, ".") - 1)) 'txsOut.WriteLine ("//SYSIN DD DSN=M51434.SMTOOL.P(#1PROC),DISP=SHR") txsOut.WriteLine ("//SYSIN DD DSN=" & nameU & ".SMTOOL.P(#1PROC),DISP=SHR") txsOut.Close Set txsOut = Nothing Set fs = Nothing fnCreateTextFile = sOutTextFile

End Function

Private Sub sbWriteGlobals(ByRef txsOut As TextStream)

txsOut.WriteBlankLines (1) txsOut.WriteLine ("%global AUDITMODE;") If frmGlobalForm.optSourceDataAudit.Value = True Then txsOut.WriteLine ("%let AUDITMODE = Y;") Else txsOut.WriteLine ("%let AUDITMODE = N;") End If   txsOut.WriteLine ("%global STRNDATA;") txsOut.WriteLine ("%let STRNDATA = " & GlobalForm.Range("B10").Value & ";") txsOut.WriteLine ("%global STABDATA;") txsOut.WriteLine ("%let STABDATA = " & GlobalForm.Range("B11").Value & ";") txsOut.WriteLine ("%macro executecustomcode;") If frmGlobalForm.txtLocation.Value <> vbNullString Then txsOut.WriteLine ("%include '" & frmGlobalForm.txtLocation.Value & "';") End If   txsOut.WriteLine ("%mend executecustomcode;") txsOut.WriteLine ("%global EMAILID;") txsOut.WriteLine ("%let EMAILID = " & GlobalForm.Range("B3").Value & ";") txsOut.WriteBlankLines (1)

End Sub

Private Sub sbWriteScoreSummary(ByVal sSheetName As String, ByRef txsOut As TextStream)

Dim shtSS As Worksheet Dim lRows As Long Dim lCntr As Long Dim rngTmp As Range Dim sDataRow As String Set shtSS = ThisWorkbook.Worksheets(sSheetName) Set rngTmp = shtSS.Range("A1") lRows = rngTmp.End(xlDown).Row

txsOut.WriteLine ("%macro scoresummary;") txsOut.WriteBlankLines (1) txsOut.WriteLine ("data scoresummary;") txsOut.WriteLine ("length") txsOut.WriteLine ("GroupName") txsOut.WriteLine ("SegmentName") txsOut.WriteLine ("SegmentVariable") txsOut.WriteLine ("ScoreName") txsOut.WriteLine ("ScoreVariable") txsOut.WriteLine ("ScoreBad") txsOut.WriteLine ("ScoreLower") txsOut.WriteLine ("ScoreUpper") txsOut.WriteLine ("ScoreExcMissing") txsOut.WriteLine ("PSI") txsOut.WriteLine ("VDI") txsOut.WriteLine ("CSI") txsOut.WriteLine ("KS") txsOut.WriteLine ("Gini") txsOut.WriteLine ("Divergence") txsOut.WriteLine ("BadRate") txsOut.WriteLine ("GainsTable") txsOut.WriteLine ("AvgScore_Goods") txsOut.WriteLine ("AvgScore_Bads") txsOut.WriteLine ("CharacteristicLevelBadRates") txsOut.WriteLine ("OddsAtBaseScore") txsOut.WriteLine ("PDO") txsOut.WriteLine ("AlignmentTable")

txsOut.WriteLine ("$45;") For lCntr = 2 To lRows 'GROUP NAME sDataRow = "GroupName = """ & rngTmp.Offset(lCntr - 1, 0).Value & """;" txsOut.WriteLine (sDataRow) 'SEGMENT NAME sDataRow = "SegmentName = """ & rngTmp.Offset(lCntr - 1, 1).Value & """;" txsOut.WriteLine (sDataRow) 'SEGMENT VARIABLE sDataRow = "SegmentVariable = """ & rngTmp.Offset(lCntr - 1, 2).Value & """;" txsOut.WriteLine (sDataRow) 'SCORE NAME sDataRow = "ScoreName = """ & rngTmp.Offset(lCntr - 1, 3).Value & """;" txsOut.WriteLine (sDataRow) 'SCORE VARIABLE sDataRow = "ScoreVariable = """ & rngTmp.Offset(lCntr - 1, 4).Value & """;" txsOut.WriteLine (sDataRow) 'SCORE BAD sDataRow = "ScoreBad = """ & rngTmp.Offset(lCntr - 1, 5).Value & """;" txsOut.WriteLine (sDataRow) 'SCORE LOWER BOUND sDataRow = "ScoreLower = """ & rngTmp.Offset(lCntr - 1, 6).Value & """;" txsOut.WriteLine (sDataRow) 'SCORE UPPER BOUND sDataRow = "ScoreUpper = """ & rngTmp.Offset(lCntr - 1, 7).Value & """;" txsOut.WriteLine (sDataRow) 'MISSING SCORE EXCLUSION sDataRow = "ScoreExcMissing = """ & rngTmp.Offset(lCntr - 1, 8).Value & """;" txsOut.WriteLine (sDataRow) 'PSI sDataRow = "PSI = """ & rngTmp.Offset(lCntr - 1, 9).Value & """;" txsOut.WriteLine (sDataRow) 'VDI sDataRow = "VDI = """ & rngTmp.Offset(lCntr - 1, 10).Value & """;" txsOut.WriteLine (sDataRow) 'CSI sDataRow = "CSI = """ & rngTmp.Offset(lCntr - 1, 11).Value & """;" txsOut.WriteLine (sDataRow) 'KS       sDataRow = "KS = """ & rngTmp.Offset(lCntr - 1, 12).Value & """;" txsOut.WriteLine (sDataRow) 'GINI sDataRow = "Gini = """ & rngTmp.Offset(lCntr - 1, 13).Value & """;" txsOut.WriteLine (sDataRow) 'DIVERGENCE sDataRow = "Divergence = """ & rngTmp.Offset(lCntr - 1, 14).Value & """;" txsOut.WriteLine (sDataRow) 'BAD RATE sDataRow = "BadRate = """ & rngTmp.Offset(lCntr - 1, 15).Value & """;" txsOut.WriteLine (sDataRow) 'GAINS TABLE sDataRow = "GainsTable = """ & rngTmp.Offset(lCntr - 1, 16).Value & """;" txsOut.WriteLine (sDataRow) 'AVG GOOD SCORE sDataRow = "AvgScore_Goods = """ & rngTmp.Offset(lCntr - 1, 17).Value & """;" txsOut.WriteLine (sDataRow) 'AVG BAD SCORE sDataRow = "AvgScore_Bads = """ & rngTmp.Offset(lCntr - 1, 18).Value & """;" txsOut.WriteLine (sDataRow) 'CHARACTERISTIC LEVEL BAD RATES sDataRow = "CharacteristicLevelBadRates = """ & rngTmp.Offset(lCntr - 1, 19).Value & """;" txsOut.WriteLine (sDataRow) 'ODDS AT BASE SCORE sDataRow = "OddsAtBaseScore = """ & rngTmp.Offset(lCntr - 1, 20).Value & """;" txsOut.WriteLine (sDataRow) 'PDO sDataRow = "PDO = """ & rngTmp.Offset(lCntr - 1, 21).Value & """;" txsOut.WriteLine (sDataRow) 'ALIGNMENT TABLE sDataRow = "AlignmentTable = """ & rngTmp.Offset(lCntr - 1, 22).Value & """;" txsOut.WriteLine (sDataRow) txsOut.WriteLine ("output;") Next lCntr txsOut.WriteLine ("run;") txsOut.WriteBlankLines (1) txsOut.WriteLine ("%mend scoresummary;") txsOut.WriteBlankLines (1)

End Sub

Private Sub sbWriteScoreSegments(ByVal sSheetName As String, ByRef txsOut As TextStream)

Dim shtSS As Worksheet Dim lRows As Long Dim lCntr As Long Dim rngTmp As Range Dim sDataRow As String Set shtSS = ThisWorkbook.Worksheets(sSheetName) Set rngTmp = shtSS.Range("A1") lRows = rngTmp.End(xlDown).Row

txsOut.WriteLine ("%macro scoresegments;") txsOut.WriteBlankLines (1) txsOut.WriteLine ("data scoresegments;") txsOut.WriteLine ("length") txsOut.WriteLine ("GroupName") txsOut.WriteLine ("SegmentName") txsOut.WriteLine ("SegmentVariable") txsOut.WriteLine ("SegmentValue") txsOut.WriteLine ("ScoreName") txsOut.WriteLine ("ScoreVariable") txsOut.WriteLine ("ImplementationDate") txsOut.WriteLine ("BenchmarkPeriod_PSI") txsOut.WriteLine ("BenchmarkPeriod_CSIVDI") txsOut.WriteLine ("BenchmarkPeriod_Strength") txsOut.WriteLine ("BenchmarkPeriod_Alignment") txsOut.WriteLine ("CurrentPeriod_PSI") txsOut.WriteLine ("CurrentPeriod_CSIVDI") txsOut.WriteLine ("CurrentPeriod_Strength") txsOut.WriteLine ("CurrentPeriod_Alignment") 'WHY ARE NUMERIC VARIABLES BEING INPUT AS CHARACTER VARIABLES?!? txsOut.WriteLine ("Benchmark_KS") txsOut.WriteLine ("Benchmark_TrueKS") txsOut.WriteLine ("Benchmark_Gini") txsOut.WriteLine ("Benchmark_Divergence") txsOut.WriteLine ("Benchmark_BadRate") txsOut.WriteLine ("Benchmark_AlignmentBaseScore") txsOut.WriteLine ("Benchmark_AlignmentOdds") txsOut.WriteLine ("Benchmark_AlignmentPDO") txsOut.WriteLine ("AvgScoreGoodsBenchmark") txsOut.WriteLine ("AvgScoreBadsBenchmark") txsOut.WriteLine ("$45;") For lCntr = 2 To lRows 'GROUP NAME sDataRow = "GroupName = """ & rngTmp.Offset(lCntr - 1, 0).Value & """;" txsOut.WriteLine (sDataRow) 'SEGMENT NAME sDataRow = "SegmentName = """ & rngTmp.Offset(lCntr - 1, 1).Value & """;" txsOut.WriteLine (sDataRow) 'SEGMENT VARIABLE sDataRow = "SegmentVariable = """ & rngTmp.Offset(lCntr - 1, 2).Value & """;" txsOut.WriteLine (sDataRow) 'SEGMENT VALUE sDataRow = "SegmentValue = """ & rngTmp.Offset(lCntr - 1, 3).Value & """;" txsOut.WriteLine (sDataRow) 'SCORE NAME sDataRow = "ScoreName = """ & rngTmp.Offset(lCntr - 1, 4).Value & """;" txsOut.WriteLine (sDataRow) 'SCORE VARIABLE sDataRow = "ScoreVariable = """ & rngTmp.Offset(lCntr - 1, 5).Value & """;" txsOut.WriteLine (sDataRow) 'IMPLEMENTATION DATE sDataRow = "ImplementationDate = """ & rngTmp.Offset(lCntr - 1, 6).Value & """;" txsOut.WriteLine (sDataRow) 'PSI BENCHMARK PERIOD sDataRow = "BenchmarkPeriod_PSI = """ & rngTmp.Offset(lCntr - 1, 7).Value & """;" txsOut.WriteLine (sDataRow) 'CSI/VDI BENCHMARK PERIOD sDataRow = "BenchmarkPeriod_CSIVDI = """ & rngTmp.Offset(lCntr - 1, 8).Value & """;" txsOut.WriteLine (sDataRow) 'STRENGTH BENCHMARK PERIOD sDataRow = "BenchmarkPeriod_Strength = """ & rngTmp.Offset(lCntr - 1, 9).Value & """;" txsOut.WriteLine (sDataRow) 'ALIGNMENT BENCHMARK PERIOD sDataRow = "BenchmarkPeriod_Alignment = """ & rngTmp.Offset(lCntr - 1, 10).Value & """;" txsOut.WriteLine (sDataRow) 'PSI CURRENT PERIOD sDataRow = "CurrentPeriod_PSI = """ & rngTmp.Offset(lCntr - 1, 11).Value & """;" txsOut.WriteLine (sDataRow) 'CSI/VDI CURRENT PERIOD sDataRow = "CurrentPeriod_CSIVDI = """ & rngTmp.Offset(lCntr - 1, 12).Value & """;" txsOut.WriteLine (sDataRow) 'STRENGTH CURRENT PERIOD sDataRow = "CurrentPeriod_Strength = """ & rngTmp.Offset(lCntr - 1, 13).Value & """;" txsOut.WriteLine (sDataRow) 'ALIGNMENT CURRENT PERIOD sDataRow = "CurrentPeriod_Alignment = """ & rngTmp.Offset(lCntr - 1, 14).Value & """;" txsOut.WriteLine (sDataRow) 'BENCHMARK KS       sDataRow = "Benchmark_KS = """ & rngTmp.Offset(lCntr - 1, 15).Text & """;" txsOut.WriteLine (sDataRow) 'BENCHMARK TRUE KS (!?!) sDataRow = "Benchmark_TrueKS = """ & rngTmp.Offset(lCntr - 1, 16).Text & """;" txsOut.WriteLine (sDataRow) 'BENCHMARK GINI sDataRow = "Benchmark_Gini = """ & rngTmp.Offset(lCntr - 1, 17).Text & """;" txsOut.WriteLine (sDataRow) 'BENCHMARK DIVERGENCE sDataRow = "Benchmark_Divergence = """ & rngTmp.Offset(lCntr - 1, 18).Text & """;" txsOut.WriteLine (sDataRow) 'BENCHMARK BAD RATE sDataRow = "Benchmark_BadRate = """ & rngTmp.Offset(lCntr - 1, 19).Text & """;" txsOut.WriteLine (sDataRow) 'BENCHMARK ALIGNMENT BASE SCORE sDataRow = "Benchmark_AlignmentBaseScore = """ & rngTmp.Offset(lCntr - 1, 20).Text & """;" txsOut.WriteLine (sDataRow) 'BENCHMARK ALIGNMENT ODDS sDataRow = "Benchmark_AlignmentOdds = """ & rngTmp.Offset(lCntr - 1, 21).Text & """;" txsOut.WriteLine (sDataRow) 'BENCHMARK ALIGNMENT PDO sDataRow = "Benchmark_AlignmentPDO = """ & rngTmp.Offset(lCntr - 1, 22).Text & """;" txsOut.WriteLine (sDataRow) 'BENCHMARK AVG SCORE GOODS sDataRow = "AvgScoreGoodsBenchmark = """ & rngTmp.Offset(lCntr - 1, 23).Text & """;" txsOut.WriteLine (sDataRow) 'BENCHMARK AVG SCORE BADS sDataRow = "AvgScoreBadsBenchmark = """ & rngTmp.Offset(lCntr - 1, 24).Text & """;" txsOut.WriteLine (sDataRow) txsOut.WriteLine ("output;") Next lCntr txsOut.WriteLine ("run;") txsOut.WriteBlankLines (1) txsOut.WriteLine ("%mend scoresegments;") txsOut.WriteBlankLines (1)

End Sub

Private Sub sbWriteScoreCharacteristics(ByVal sSheetName As String, ByRef txsOut As TextStream)

Dim shtSS As Worksheet Dim lRows As Long Dim lCntr As Long Dim rngTmp As Range Dim sDataRow As String Set shtSS = ThisWorkbook.Worksheets(sSheetName) Set rngTmp = shtSS.Range("A1") lRows = rngTmp.End(xlDown).Row If rngTmp.Offset(1, 0).Value = vbNullString Then txsOut.WriteLine ("%macro scorecharacteristics;") txsOut.WriteLine ("data scorecharacteristics;") txsOut.WriteLine ("length") txsOut.WriteLine ("GroupName") txsOut.WriteLine ("SegmentName") txsOut.WriteLine ("SegmentVariable") txsOut.WriteLine ("SegmentValue") txsOut.WriteLine ("ScoreName") txsOut.WriteLine ("ScoreVariable") txsOut.WriteLine ("CharacteristicName") txsOut.WriteLine ("CharacteristicDescription") txsOut.WriteLine ("$45;") txsOut.WriteLine ("run;") txsOut.WriteLine ("%mend scorecharacteristics;") Exit Sub End If

txsOut.WriteLine ("%macro scorecharacteristics;") txsOut.WriteBlankLines (1) txsOut.WriteLine ("data scorecharacteristics;") txsOut.WriteLine ("length") txsOut.WriteLine ("GroupName") txsOut.WriteLine ("SegmentName") txsOut.WriteLine ("SegmentVariable") txsOut.WriteLine ("SegmentValue") txsOut.WriteLine ("ScoreName") txsOut.WriteLine ("ScoreVariable") txsOut.WriteLine ("CharacteristicName") txsOut.WriteLine ("CharacteristicDescription") txsOut.WriteLine ("$45;") For lCntr = 2 To lRows 'GROUP NAME sDataRow = "GroupName = """ & rngTmp.Offset(lCntr - 1, 0).Value & """;" txsOut.WriteLine (sDataRow) 'SEGMENT NAME sDataRow = "SegmentName = """ & rngTmp.Offset(lCntr - 1, 1).Value & """;" txsOut.WriteLine (sDataRow) 'SEGMENT VARIABLE sDataRow = "SegmentVariable = """ & rngTmp.Offset(lCntr - 1, 2).Value & """;" txsOut.WriteLine (sDataRow) 'SEGMENT VALUE sDataRow = "SegmentValue = """ & rngTmp.Offset(lCntr - 1, 3).Value & """;" txsOut.WriteLine (sDataRow) 'SCORE NAME sDataRow = "ScoreName = """ & rngTmp.Offset(lCntr - 1, 4).Value & """;" txsOut.WriteLine (sDataRow) 'SCORE VARIABLE sDataRow = "ScoreVariable = """ & rngTmp.Offset(lCntr - 1, 5).Value & """;" txsOut.WriteLine (sDataRow) 'CHARACTERISTIC NAME sDataRow = "CharacteristicName = """ & rngTmp.Offset(lCntr - 1, 6).Value & """;" txsOut.WriteLine (sDataRow) 'CHARACTERISTIC DESCRIPTION sDataRow = "CharacteristicDescription = """ & rngTmp.Offset(lCntr - 1, 7).Value & """;" txsOut.WriteLine (sDataRow) txsOut.WriteLine ("output;") Next lCntr txsOut.WriteLine ("run;") txsOut.WriteBlankLines (1) txsOut.WriteLine ("%mend scorecharacteristics;") txsOut.WriteBlankLines (1)

End Sub

Private Sub sbWritePSIDetails(ByVal sSheetName As String, ByRef txsOut As TextStream)

Dim shtSS As Worksheet Dim lRows As Long Dim lCntr As Long Dim ctr, ctr2, CalledFlag As Integer Dim rngTmp As Range Dim sDataRow As String

Set shtSS = ThisWorkbook.Worksheets(sSheetName) Set rngTmp = shtSS.Range("A1") ctr2 = 0 For ctr = 0 To 14 If ThisWorkbook.sheets("Score Summary - Formula").Range("A1").Offset(ctr + 1, 0).Value <> "NA" And _ ThisWorkbook.sheets("Score Summary - Formula").Range("A1").Offset(ctr + 1, 1).Value <> "NA" And _ ThisWorkbook.sheets("Score Summary - Formula").Range("A1").Offset(ctr + 1, 3).Value <> "NA" And _ ThisWorkbook.sheets("Score Summary - Formula").Range("A1").Offset(ctr + 1, 9).Value <> "N" Then txsOut.WriteLine ("%macro psi_" & Int(ctr / 5) + 1 & "_" & ctr Mod 5 + 1 & ";") Do While ThisWorkbook.sheets("PSI Detail").Range("A2").Offset(ctr2, 1).Value <> "" If ThisWorkbook.sheets("PSI Detail").Range("A2").Offset(ctr2, 1).Value = ThisWorkbook.sheets("Score Summary - Formula").Range("A1").Offset(ctr + 1, 2).Value And _ ThisWorkbook.sheets("PSI Detail").Range("A2").Offset(ctr2, 0).Value = ThisWorkbook.sheets("Score Summary - Formula").Range("A1").Offset(ctr + 1, 4).Value Then Call createPSIDetailMacro(ctr, ctr2, txsOut) End If           ctr2 = ctr2 + 1 Loop txsOut.WriteLine ("%mend ;") ctr2 = 0 Else Call createPSIDetailBlankMacro(ctr, txsOut) End If Next End Sub Private Sub createPSIDetailMacro(ByVal ctr As Integer, ByVal ctr2 As Integer, ByRef txsOut As TextStream) Dim LowEquality, HighEquality As String

'If ThisWorkbook.sheets("PSI Detail").Range("A2").Offset(ctr2, 8).Value = "<=" Then LowEquality = "GE" 'If ThisWorkbook.sheets("PSI Detail").Range("A2").Offset(ctr2, 8).Value = "=" Then LowEquality = "EQ" 'If ThisWorkbook.sheets("PSI Detail").Range("A2").Offset(ctr2, 8).Value = "<" Then LowEquality = "GT" 'If ThisWorkbook.sheets("PSI Detail").Range("A2").Offset(ctr2, 9).Value = "<=" Then HighEquality = "LE" 'If ThisWorkbook.sheets("PSI Detail").Range("A2").Offset(ctr2, 9).Value = "=" Then HighEquality = "EQ" 'If ThisWorkbook.sheets("PSI Detail").Range("A2").Offset(ctr2, 9).Value = "<" Then HighEquality = "LT" If ThisWorkbook.sheets("PSI Detail").Range("A2").Offset(ctr2, 8).Value = "N" Then LowEquality = "GE" If ThisWorkbook.sheets("PSI Detail").Range("A2").Offset(ctr2, 8).Value = "Y" Then LowEquality = "GT" If ThisWorkbook.sheets("PSI Detail").Range("A2").Offset(ctr2, 9).Value = "N" Then HighEquality = "LE" If ThisWorkbook.sheets("PSI Detail").Range("A2").Offset(ctr2, 9).Value = "Y" Then HighEquality = "LT"

txsOut.WriteBlankLines (1)

'THIS LOGIC WILL NOT WORK 'If ctr2 > 0 Then 'txsOut.WriteLine ("else") 'End If

txsOut.WriteLine ("if " & ThisWorkbook.sheets("PSI Detail").Range("A2").Offset(ctr2, 1).Value & " = """ & ThisWorkbook.sheets("PSI Detail").Range("A2").Offset(ctr2, 2).Text & """ and ") txsOut.WriteLine (ThisWorkbook.sheets("PSI Detail").Range("A2").Offset(ctr2, 0).Value & " " & LowEquality & " " & ThisWorkbook.sheets("PSI Detail").Range("A2").Offset(ctr2, 4).Text & " and ") txsOut.WriteLine (ThisWorkbook.sheets("PSI Detail").Range("A2").Offset(ctr2, 0).Value & " " & HighEquality & " " & ThisWorkbook.sheets("PSI Detail").Range("A2").Offset(ctr2, 5).Text & " Then Do ;") txsOut.WriteLine ("PSI_" & Int(ctr / 5) + 1 & "_" & ctr Mod 5 + 1 & " = """ & ThisWorkbook.sheets("PSI Detail").Range("A2").Offset(ctr2, 6).Value & """ ;") txsOut.WriteLine ("BTcount_" & Int(ctr / 5) + 1 & "_" & ctr Mod 5 + 1 & " = " & ThisWorkbook.sheets("PSI Detail").Range("A2").Offset(ctr2, 10).Value & " ;") txsOut.WriteLine ("BTPercent_" & Int(ctr / 5) + 1 & "_" & ctr Mod 5 + 1 & " = " & ThisWorkbook.sheets("PSI Detail").Range("A2").Offset(ctr2, 11).Value & " ;") txsOut.WriteLine ("end;")

'   If CalledFlag = 0 Then '       txsout.WriteLine ("%mend;") '   End If End Sub Private Sub createPSIDetailBlankMacro(ByVal ctr As Integer, ByRef txsOut As TextStream) txsOut.WriteLine ("%macro psi_" & Int(ctr / 5) + 1 & "_" & ctr Mod 5 + 1 & ";") txsOut.WriteLine ("%mend;") End Sub

Private Sub sbWriteCharDetails(ByVal sSheetName As String, ByRef txsOut As TextStream)

Dim shtSS As Worksheet Dim lRows As Long Dim lCntr, ctr2, ctr3, ctr4, ctr As Long Dim rngTmp As Range Dim rngTmp2 As Range Dim sDataRow As String

Set rngTmp = ThisWorkbook.Worksheets("Group Detail - Characteristics").Columns("G:G") rngTmp.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=ThisWorkbook.Worksheets("Group Detail - Characteristics").Range("M1"), Unique:=True Set rngTmp = ThisWorkbook.Worksheets("Group Detail - Characteristics").Range("M2")

Set shtSS = ThisWorkbook.Worksheets(sSheetName) 'Set rngTmp = shtSS.Range("A1") 'lRows = rngTmp.End(xlDown).Row

ctr3 = 0 ctr2 = 0 For ctr = 0 To 14 If ThisWorkbook.sheets("Score Summary - Formula").Range("A1").Offset(ctr + 1, 0).Value <> "NA" And _ ThisWorkbook.sheets("Score Summary - Formula").Range("A1").Offset(ctr + 1, 1).Value <> "NA" And _ ThisWorkbook.sheets("Score Summary - Formula").Range("A1").Offset(ctr + 1, 3).Value <> "NA" And _ (ThisWorkbook.sheets("Score Summary - Formula").Range("A1").Offset(ctr + 1, 10).Value = "Y" Or _   ThisWorkbook.sheets("Score Summary - Formula").Range("A1").Offset(ctr + 1, 11).Value = "Y") Then

txsOut.WriteLine ("%macro char_" & Int(ctr / 5) + 1 & "_" & ctr Mod 5 + 1 & ";") Set rngTmp = ThisWorkbook.Worksheets("Group Detail - Characteristics").Columns("G:G") rngTmp.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=ThisWorkbook.Worksheets("Group Detail - Characteristics").Range("M1"), Unique:=True Set rngTmp = ThisWorkbook.Worksheets("Group Detail - Characteristics").Range("M2") Do While Not IsEmpty(rngTmp) txsOut.WriteLine ("length " & rngTmp.Value & "_BIN $45;") Set rngTmp = rngTmp.Offset(1, 0) Loop ThisWorkbook.Worksheets("Group Detail - Characteristics").Columns("M:M").ClearContents Do While ThisWorkbook.sheets("Group Detail - Characteristics").Range("A2").Offset(ctr3, 0).Value <> "" If ThisWorkbook.sheets("Score Summary - Formula").Range("A1").Offset(ctr + 1, 0).Value = ThisWorkbook.sheets("Group Detail - Characteristics").Range("A2").Offset(ctr3, 0).Value And _ ThisWorkbook.sheets("Score Summary - Formula").Range("A1").Offset(ctr + 1, 1).Value = ThisWorkbook.sheets("Group Detail - Characteristics").Range("A2").Offset(ctr3, 1).Value And _ ThisWorkbook.sheets("Score Summary - Formula").Range("A1").Offset(ctr + 1, 2).Value = ThisWorkbook.sheets("Group Detail - Characteristics").Range("A2").Offset(ctr3, 2).Value And _ ThisWorkbook.sheets("Score Summary - Formula").Range("A1").Offset(ctr + 1, 3).Value = ThisWorkbook.sheets("Group Detail - Characteristics").Range("A2").Offset(ctr3, 4).Value And _ ThisWorkbook.sheets("Score Summary - Formula").Range("A1").Offset(ctr + 1, 4).Value = ThisWorkbook.sheets("Group Detail - Characteristics").Range("A2").Offset(ctr3, 5).Value Then Do While ThisWorkbook.sheets("Characteristic Detail").Range("A2").Offset(ctr2, 1).Value <> "" If ThisWorkbook.sheets("Characteristic Detail").Range("A2").Offset(ctr2, 1).Value = ThisWorkbook.sheets("Group Detail - Characteristics").Range("A2").Offset(ctr3, 2).Value And _ ThisWorkbook.sheets("Characteristic Detail").Range("A2").Offset(ctr2, 0).Value = ThisWorkbook.sheets("Group Detail - Characteristics").Range("A2").Offset(ctr3, 5).Value And _ ThisWorkbook.sheets("Characteristic Detail").Range("A2").Offset(ctr2, 3).Value = ThisWorkbook.sheets("Group Detail - Characteristics").Range("A2").Offset(ctr3, 6).Value Then Call createCharDetailMacro(ctr, ctr2, UCase(ThisWorkbook.sheets("Group Detail - Characteristics").Range("A2").Offset(ctr3, 8).Value), txsOut) End If           ctr2 = ctr2 + 1 Loop ctr2 = 0 End If   ctr3 = ctr3 + 1 Loop ctr3 = 0 txsOut.WriteLine ("%mend ;")

Else Call createCharDetailBlankMacro(ctr, txsOut) End If Next ThisWorkbook.Worksheets("Group Detail - Characteristics").Columns("M:M").ClearContents End Sub

Private Sub createCharDetailMacro(ByVal ctr As Integer, ByVal ctr2 As Integer, ByVal sNumChar As String, ByRef txsOut As TextStream) Dim LowEquality, HighEquality, Equality As String

'If ThisWorkbook.sheets("Characteristic Detail").Range("A2").Offset(ctr2, 6).Value = "<=" Then LowEquality = "GE" 'If ThisWorkbook.sheets("Characteristic Detail").Range("A2").Offset(ctr2, 6).Value = "=" Then LowEquality = "EQ" 'If ThisWorkbook.sheets("Characteristic Detail").Range("A2").Offset(ctr2, 6).Value = "<" Then LowEquality = "GT" 'If ThisWorkbook.sheets("Characteristic Detail").Range("A2").Offset(ctr2, 8).Value = "<=" Then HighEquality = "LE" 'If ThisWorkbook.sheets("Characteristic Detail").Range("A2").Offset(ctr2, 8).Value = "=" Then HighEquality = "EQ" 'If ThisWorkbook.sheets("Characteristic Detail").Range("A2").Offset(ctr2, 8).Value = "<" Then HighEquality = "LT"

txsOut.WriteBlankLines (1)

'THIS LOGIC WILL NOT WORK 'If ctr2 > 0 Then 'txsOut.WriteLine ("else") 'End If

txsOut.WriteLine ("if " & ThisWorkbook.sheets("Characteristic Detail").Range("A2").Offset(ctr2, 1).Value & " = """ & ThisWorkbook.sheets("Characteristic Detail").Range("A2").Offset(ctr2, 2).Text & """ and ")

If (sNumChar = "N" Or sNumChar = "1") Then If ThisWorkbook.sheets("Characteristic Detail").Range("A2").Offset(ctr2, 9).Value = "N" Then LowEquality = "GE" If ThisWorkbook.sheets("Characteristic Detail").Range("A2").Offset(ctr2, 9).Value = "Y" Then LowEquality = "GT" If ThisWorkbook.sheets("Characteristic Detail").Range("A2").Offset(ctr2, 10).Value = "N" Then HighEquality = "LE" If ThisWorkbook.sheets("Characteristic Detail").Range("A2").Offset(ctr2, 10).Value = "Y" Then HighEquality = "LT" txsOut.WriteLine (ThisWorkbook.sheets("Characteristic Detail").Range("A2").Offset(ctr2, 3).Value & " " & LowEquality & " " & ThisWorkbook.sheets("Characteristic Detail").Range("A2").Offset(ctr2, 5).Value & " and ") txsOut.WriteLine (ThisWorkbook.sheets("Characteristic Detail").Range("A2").Offset(ctr2, 3).Value & " " & HighEquality & " " & ThisWorkbook.sheets("Characteristic Detail").Range("A2").Offset(ctr2, 6).Value & " Then Do ;") End If

If (sNumChar = "C" Or sNumChar = "2") Then Equality = "EQ" txsOut.WriteLine (ThisWorkbook.sheets("Characteristic Detail").Range("A2").Offset(ctr2, 3).Value & " " & Equality & " """ & ThisWorkbook.sheets("Characteristic Detail").Range("A2").Offset(ctr2, 5).Text & """ Then Do ;") End If

txsOut.WriteLine (ThisWorkbook.sheets("Characteristic Detail").Range("A2").Offset(ctr2, 3).Value & "_BIN = """ & ThisWorkbook.sheets("Characteristic Detail").Range("A2").Offset(ctr2, 7).Value & """ ;") txsOut.WriteLine (ThisWorkbook.sheets("Characteristic Detail").Range("A2").Offset(ctr2, 3).Value & "_count = " & ThisWorkbook.sheets("Characteristic Detail").Range("A2").Offset(ctr2, 11).Value & " ;") txsOut.WriteLine (ThisWorkbook.sheets("Characteristic Detail").Range("A2").Offset(ctr2, 3).Value & "_Percent = " & ThisWorkbook.sheets("Characteristic Detail").Range("A2").Offset(ctr2, 12).Value & " ;") txsOut.WriteLine (ThisWorkbook.sheets("Characteristic Detail").Range("A2").Offset(ctr2, 3).Value & "_Points = " & ThisWorkbook.sheets("Characteristic Detail").Range("A2").Offset(ctr2, 13).Value & " ;") txsOut.WriteLine ("end;")

End Sub Private Sub createCharDetailBlankMacro(ByVal ctr As Integer, ByRef txsOut As TextStream) txsOut.WriteLine ("%macro char_" & Int(ctr / 5) + 1 & "_" & ctr Mod 5 + 1 & ";") txsOut.WriteLine ("%mend;") End Sub

Private Sub sbWriteAllCharacteristics(ByVal sSheetName As String, ByRef txsOut As TextStream)

Dim shtSS As Worksheet Dim lRows As Long Dim lCntr As Long Dim rngTmp As Range Dim sDataRow As String Set shtSS = ThisWorkbook.Worksheets(sSheetName) Set rngTmp = shtSS.Range("A1") lRows = rngTmp.End(xlDown).Row If rngTmp.Offset(1, 0).Value = vbNullString Then txsOut.WriteLine ("%macro allcharacteristics;") txsOut.WriteBlankLines (1) txsOut.WriteLine ("data allcharacteristics;") txsOut.WriteLine ("length") txsOut.WriteLine ("SegmentVariable") txsOut.WriteLine ("SegmentValue") txsOut.WriteLine ("ScoreVariable") txsOut.WriteLine ("CharacteristicName") txsOut.WriteLine ("CharacteristicBin") 'NUMERIC VARIABLES!?! 'txsOut.WriteLine ("Benchmark_Cnt") 'txsOut.WriteLine ("Benchmark_Percent") 'txsOut.WriteLine ("Points") 'txsOut.WriteLine ("Benchmark_BadRate") txsOut.WriteLine ("$45;") txsOut.WriteLine ("%mend allcharacteristics;") Exit Sub End If

txsOut.WriteLine ("%macro allcharacteristics;") txsOut.WriteBlankLines (1) txsOut.WriteLine ("data allcharacteristics;") txsOut.WriteLine ("length") txsOut.WriteLine ("SegmentVariable") txsOut.WriteLine ("SegmentValue") txsOut.WriteLine ("ScoreVariable") txsOut.WriteLine ("CharacteristicName") txsOut.WriteLine ("CharacteristicBin") 'NUMERIC VARIABLES!?! 'txsOut.WriteLine ("Benchmark_Cnt") 'txsOut.WriteLine ("Benchmark_Percent") 'txsOut.WriteLine ("Points") 'txsOut.WriteLine ("Benchmark_BadRate") txsOut.WriteLine ("$45;") For lCntr = 2 To lRows 'SEGMENT VARIABLE sDataRow = "SegmentVariable = """ & rngTmp.Offset(lCntr - 1, 1).Value & """;" txsOut.WriteLine (sDataRow) 'SEGMENT VALUE sDataRow = "SegmentValue = """ & rngTmp.Offset(lCntr - 1, 2).Value & """;" txsOut.WriteLine (sDataRow) 'SCORE VARIABLE sDataRow = "ScoreVariable = """ & rngTmp.Offset(lCntr - 1, 0).Value & """;" txsOut.WriteLine (sDataRow) 'CHARACTERISTIC NAME sDataRow = "CharacteristicName = """ & rngTmp.Offset(lCntr - 1, 3).Value & """;" txsOut.WriteLine (sDataRow) 'BIN DESCRIPTION / LABEL sDataRow = "CharacteristicBin = """ & rngTmp.Offset(lCntr - 1, 7).Value & """;" txsOut.WriteLine (sDataRow) '# BENCHMARK sDataRow = "Benchmark_Cnt = " & rngTmp.Offset(lCntr - 1, 11).Value & ";" txsOut.WriteLine (sDataRow) '% BENCHMARK sDataRow = "Benchmark_Percent = " & rngTmp.Offset(lCntr - 1, 12).Value & ";" txsOut.WriteLine (sDataRow) 'POINTS / WEIGHTS sDataRow = "Points = " & rngTmp.Offset(lCntr - 1, 13).Value & ";" txsOut.WriteLine (sDataRow) 'THIS NEEDS TO BE MODIFIED WHILE ADDING CHARACTERISTIC LEVEL BAD RATES 'BENCHMARK #ACCOUNTS (?!) 'sDataRow = "Benchmark_NACC = " & rngTmp.Offset(lCntr - 1, 14).Value & ";" 'txsOut.WriteLine (sDataRow) 'BENCHMARK #BADS (?!) 'sDataRow = "Benchmark_NBAD = " & rngTmp.Offset(lCntr - 1, 15).Value & ";" 'txsOut.WriteLine (sDataRow) 'BENCHMARK BAD RATE (?!) 'sDataRow = "Benchmark_BadRate = " & rngTmp.Offset(lCntr - 1, 16).Value & ";" 'txsOut.WriteLine (sDataRow) 'BENCHMARK #ACCOUNTS (?!) sDataRow = "Benchmark_NACC = 'NA';" txsOut.WriteLine (sDataRow) 'BENCHMARK #BADS (?!) sDataRow = "Benchmark_NBAD = 'NA';" txsOut.WriteLine (sDataRow) 'BENCHMARK BAD RATE (?!) sDataRow = "Benchmark_BadRate = 'NA';" txsOut.WriteLine (sDataRow) txsOut.WriteLine ("output;") Next lCntr txsOut.WriteLine ("run;") txsOut.WriteBlankLines (1) txsOut.WriteLine ("%mend allcharacteristics;") txsOut.WriteBlankLines (1)

End Sub

""frmCharVarList Private Sub cmdHideChar_Click cmdDone.Enabled = False cmdCancel.Enabled = False cmdAppend.Enabled = False cmdRefresh.Enabled = False cmdHideChar.Enabled = False cmdEnable.Enabled = True lstCharSelect.Enabled = False '   Inp0Button.Range("F2:I3").Interior.ColorIndex = 6 '   Inp0Button.Range("F2:I3").Interior.Pattern = xlSolid '   Inp0Button.Range("F2:I3").Font.ColorIndex = 3 Inp0Button.cmdGroup.Enabled = False Inp0Button.cmdSuite.Enabled = False Inp0Button.cmdVariables.Enabled = False Inp0Button.cmdFormats.Enabled = False '   Inp0Button.Range("B2").Value = 1 '   frmCharVarList.Hide Inp0Button.Range("B10").Value = 0 '   Inp0Button.Range("F10:I11").Interior.ColorIndex = xlNone '   Inp0Button.Range("F10:I11").Font.ColorIndex = 2 frmCharVarList.Hide frmCharVarList.Show vbModeless End Sub

Private Sub cmdEnable_Click cmdDone.Enabled = True cmdCancel.Enabled = True cmdAppend.Enabled = True cmdRefresh.Enabled = True cmdHideChar.Enabled = True cmdEnable.Enabled = False lstCharSelect.Enabled = True frmCharVarList.Hide frmCharVarList.Show vbModal End Sub

Private Sub UserForm_Activate Dim k, l, cntGrp, cntFrm, cntVar As Integer 'NEW CODE TO LOAD CHARACTERISTIC (VARIABLE) LIST AT FORM INITIALIZATION var.Activate cntVar = WorksheetFunction.CountA(var.Range("A:A")) frmCharVarList.lstCharSelect.RowSource = Range("A2:C" & cntVar).Address cntGrp = frmGroupView.lstCharacteristicName.ListCount cntFrm = frmCharVarList.lstCharSelect.ListCount If cntGrp > 0 Then For k = 0 To cntGrp - 1 For l = 0 To cntFrm - 1 If frmGroupView.lstCharacteristicName.List(k) = frmCharVarList.lstCharSelect.List(l) Then frmCharVarList.lstCharSelect.Selected(l) = True End If           Next l        Next k    End If End Sub

'DISABLE X BUTTON ON USERFORM Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) If CloseMode = vbFormControlMenu Then Cancel = True MsgBox "Please use the buttons on the form" End If End Sub

'ADD NEW LINE AFTER UPDATE Private Sub txtCharacteristicVariable_AfterUpdate Dim charVar As String Dim m, cntLin, addBlank As Integer

Dim strMultiLineData, x As Integer strMultiLineData = Split(frmCharVarList.txtCharacteristicVariable, vbCrLf)

txtCharacteristicVariable.SetFocus addBlank = 0 cntLin = txtCharacteristicVariable.LineCount If (txtCharacteristicVariable.Text <> "" And cntLin > 0) Then For m = 0 To cntLin - 1 charVar = UCase(strMultiLineData(m)) If charVar = "" Then addBlank = addBlank + 1 End If       Next m    End If    If addBlank = 0 Then txtCharacteristicVariable.Text = txtCharacteristicVariable.Text & vbCrLf & "" End If End Sub

'APPEND CHARACTERISTIC VARIABLES Private Sub cmdAppend_Click Dim charVar As String Dim j, k, m, n, cntLin, cntLim, cntMatch As Integer

cntLim = 0 For j = 0 To frmCharVarList.lstCharSelect.ListCount - 1 If frmCharVarList.lstCharSelect.Selected(j) = True Then cntLim = cntLim + 1 End If Next j

Dim strMultiLineData, x As Integer strMultiLineData = Split(frmCharVarList.txtCharacteristicVariable, vbCrLf)

txtCharacteristicVariable.SetFocus cntLin = txtCharacteristicVariable.LineCount If cntLin > 1 Then If (cntLin + cntLim) > 20 Then MsgBox "You cannot add more than " & 20 - cntLim & " variables! " & cntLim & " variables already selected.", vbInformation + vbOKOnly, mConstants.sToolName Exit Sub End If   For m = 0 To cntLin - 1 cntMatch = 0 charVar = UCase(strMultiLineData(m)) For n = 0 To frmCharVarList.lstCharSelect.ListCount - 1 If charVar = frmCharVarList.lstCharSelect.List(n) Then frmCharVarList.lstCharSelect.Selected(n) = True cntMatch = cntMatch + 1 End If       Next n        If (charVar <> "" And cntMatch = 0) Then MsgBox "Could not find" & charVar, vbOKOnly + vbCritical End If   Next m End If End Sub

'REFRESH CHARACTERISTIC VARIABLES Private Sub cmdRefresh_Click Dim charVar As String Dim j, k, m, n, cntLin, cntMatch As Integer

For n = 0 To frmCharVarList.lstCharSelect.ListCount - 1 frmCharVarList.lstCharSelect.Selected(n) = False Next n

Dim strMultiLineData, x As Integer strMultiLineData = Split(frmCharVarList.txtCharacteristicVariable, vbCrLf)

txtCharacteristicVariable.SetFocus cntLin = txtCharacteristicVariable.LineCount If cntLin > 1 Then If cntLin > 20 Then MsgBox "You cannot select more than 20 variables!", vbInformation + vbOKOnly, mConstants.sToolName Exit Sub End If   For m = 0 To cntLin - 1 cntMatch = 0 charVar = UCase(strMultiLineData(m)) For n = 0 To frmCharVarList.lstCharSelect.ListCount - 1 If charVar = frmCharVarList.lstCharSelect.List(n) Then frmCharVarList.lstCharSelect.Selected(n) = True cntMatch = cntMatch + 1 End If       Next n        If (charVar <> "" And cntMatch = 0) Then MsgBox "Could not find" & charVar, vbOKOnly + vbCritical End If   Next m End If End Sub

'DONE SELECTING VARIABLES Private Sub cmdDone_Click Dim var, des, typ As String Dim i, j, dup, cnt, ext, cntLim, cntSel, lstRow, StartRange, EndRange As Integer

cntLim = 0 For j = 0 To frmCharVarList.lstCharSelect.ListCount - 1 If frmCharVarList.lstCharSelect.Selected(j) = True Then cntLim = cntLim + 1 End If Next j

If cntLim > 20 Then MsgBox "You cannot select more than 20 variables. You have selected " & cntLim & " variables", vbInformation + vbOKOnly, mConstants.sToolName Exit Sub End If

'ADD NEWLY SELECTED ITEMS cntSel = 0 For i = 0 To frmCharVarList.lstCharSelect.ListCount - 1 If frmCharVarList.lstCharSelect.Selected(i) = True Then var = UCase("" & frmCharVarList.lstCharSelect.List(i)) des = UCase("" & frmCharVarList.lstCharSelect.List(i, 1)) typ = UCase("" & frmCharVarList.lstCharSelect.List(i, 2)) cnt = frmGroupView.lstCharacteristicName.ListCount dup = 0 If cnt > 0 Then For j = 0 To cnt - 1 If var = UCase("" & frmGroupView.lstCharacteristicName.List(j)) Then dup = dup + 1 Exit For End If           Next j        End If        cntSel = frmGroupView.lstCharacteristicName.ListCount If dup = 0 Then frmGroupView.lstCharacteristicName.AddItem (var) frmGroupView.lstCharacteristicName.List(cntSel, 1) = des frmGroupView.lstCharacteristicName.List(cntSel, 2) = typ End If   End If Next i

'DELETE NEWLY UNSELECTED ITEMS For i = 0 To frmCharVarList.lstCharSelect.ListCount - 1 If frmCharVarList.lstCharSelect.Selected(i) = False Then var = UCase("" & frmCharVarList.lstCharSelect.List(i)) cnt = frmGroupView.lstCharacteristicName.ListCount ext = 0 If cnt > 0 Then For j = 0 To cnt - 1 If var = UCase("" & frmGroupView.lstCharacteristicName.List(j)) Then ext = ext + 1 Exit For End If           Next j        End If        If ext > 0 Then frmGroupView.lstCharacteristicName.RemoveItem (j) End If   End If Next i

'Inp0Button.Range("B2").Value = 0 frmCharVarList.Hide Unload frmCharVarList

'frmGroupView.Show Inp0Button.Range("B10").Value = 0

'Inp0Button.Range("F10:I11").Interior.ColorIndex = 6 'Inp0Button.Range("F10:I11").Interior.Pattern = xlSolid 'Inp0Button.Range("F10:I11").Font.ColorIndex = 3

Inp0Button.cmdGroup.Enabled = False Inp0Button.cmdSuite.Enabled = False Inp0Button.cmdVariables.Enabled = False Inp0Button.cmdFormats.Enabled = False

StartRange = frmGroupView.CalculateCellRowCharacteristic(frmGroupView.SelGrpIndx + 1, frmGroupView.SelScrIndx + 1, frmGroupView.SelSegIndx + 1, 1) EndRange = frmGroupView.CalculateCellRowCharacteristic(frmGroupView.SelGrpIndx + 1, frmGroupView.SelScrIndx + 1, frmGroupView.SelSegIndx + 2, 1) - 1

Call frmGroupView.addCharacteristicVaribles(StartRange, EndRange) Call frmGroupView.deleteCharacteristicVariables Call frmGroupView.RefreshCharacteristicList

Inp0Button.Range("B10").Value = 1

End Sub

Private Sub cmdCancel_Click 'Inp0Button.Range("B2").Value = 0 frmCharVarList.Hide Unload frmCharVarList

'frmGroupView.Show Inp0Button.Range("B10").Value = 0

'Inp0Button.Range("F10:I11").Interior.ColorIndex = 6 'Inp0Button.Range("F10:I11").Interior.Pattern = xlSolid 'Inp0Button.Range("F10:I11").Font.ColorIndex = 3

Inp0Button.cmdGroup.Enabled = False Inp0Button.cmdSuite.Enabled = False Inp0Button.cmdVariables.Enabled = False Inp0Button.cmdFormats.Enabled = False

Inp0Button.Range("B10").Value = 1 End Sub

""frmDescriptionChange Private Sub cmdDescriptionOK_Click

frmDescriptionChange.Hide

End Sub

Private Sub UserForm_Click

End Sub

""frmGlobalForm

Dim Flag As String, Maxsourcedata As Integer

Private Sub cmdCancel_Click Unload Me End Sub

Private Sub cmdSave_Click Dim Suite_Name As String, Suite_Key As String, Run_Period As String, Username As String, Password As String, Server As String, Port As String, Cost_Code As String Dim Platform As String Dim Source_Data As String Dim Strength As String, Stability As String Dim Cust_code As String, Location As String, Enter_code As String Dim Mode_Run As String Dim ProjectPath As String ProjectPath = ThisWorkbook.Path Suite_Name = txtSuiteName.Text Suite_Key = txtSuiteKey.Text Run_Period = txtRunPeriod.Text Username = txtUserName.Text 'Password = txtPassword.Text Server = txtServer.Text Port = txtPort.Text Cost_Code = txtCostCode.Text If optMainFrame = True Then Platform = "Mainframe" If optUnix = True Then Platform = "Unix" Strength = txtStrength.Text Stabilty = txtStabilty.Text If chkNoCode = True Then Cust_code = "No Code" Location = txtLocation.Text 'Enter_code = txtCode.Text If optSourceDataAudit = True Then Mode_Run = "Audit" If optSourceDataMonitoring = True Then Mode_Run = "Monitoring" 'ThisWorkbook.Worksheets("GlobalForm").Visible = True 'ThisWorkbook.Worksheets("GlobalForm").Activate ThisWorkbook.Worksheets("GlobalForm").Range("B1").Value = Suite_Name ThisWorkbook.Worksheets("GlobalForm").Range("B2").Value = Suite_Key ThisWorkbook.Worksheets("GlobalForm").Range("B3").Value = Run_Period ThisWorkbook.Worksheets("GlobalForm").Range("B5").Value = Username 'ThisWorkbook.Worksheets("GlobalForm").Range("B5").Value = Password ThisWorkbook.Worksheets("GlobalForm").Range("B7").Value = Server ThisWorkbook.Worksheets("GlobalForm").Range("B8").Value = Port ThisWorkbook.Worksheets("GlobalForm").Range("B9").Value = Cost_Code ThisWorkbook.Worksheets("GlobalForm").Range("B4").Value = Platform ThisWorkbook.Worksheets("GlobalForm").Range("B10").Value = Strength ThisWorkbook.Worksheets("GlobalForm").Range("B11").Value = Stabilty ThisWorkbook.Worksheets("GlobalForm").Range("B12").Value = Cust_code ThisWorkbook.Worksheets("GlobalForm").Range("B13").Value = Location ThisWorkbook.Worksheets("GlobalForm").Range("B14").Value = Enter_code ThisWorkbook.Worksheets("GlobalForm").Range("B15").Value = Mode_Run 'ThisWorkbook.Worksheets("GlobalForm").Visible = False

ChDir ProjectPath On Error Resume Next 'ThisWorkbook.SaveAs (ProjectPath & "TempReport" & ".xls") 'ThisWorkbook.Save End Sub

Private Sub cmdSourcedataadd_Click Maxsourcedata = lstSourceData.ListCount 'If Flag = "EDIT" Then 'Call AddOREditGroup 'txtSourceData.Text = "" 'cmdSourcedataadd.Caption = "Add" 'Flag = " " ' 'Else

If txtSourceData.Text <> "" Then 'lstSourceData.AddItem txtSourceData.Text Flag = "ADD" Call AddOREditGroup cmdSourceDataediy.Caption = "Edit" txtSourceData.Text = "" Flag = " " Else MsgBox "Source dataset name missing", vbCritical + vbOKOnly, mConstants.sToolName End If

lblSourcedatacount.Caption = "Number of source datasets entered - " & lstSourceData.ListCount

Sourcedata.Cells(1, 3).Value = lstSourceData.ListCount End Sub

Private Sub cmdSourceDatadelete_Click If Not (Flag = "ADD" Or Flag = "EDIT") Then If lstSourceData.ListIndex = -1 Then MsgBox "Select item to delete", vbInformation + vbOKOnly, mConstants.sToolName ElseIf MsgBox("Delete selected?", vbQuestion + vbYesNo, mConstants.sToolName) = vbYes Then Sourcedata.Cells((lstSourceData.ListIndex + 1), 2).Delete Shift:=xlUp Maxsourcedata = lstSourceData.ListCount - 1

Call RefreshGroupList lblSourcedatacount.Caption = "Number of source datasets entered - " & lstSourceData.ListCount Sourcedata.Cells(1, 3).Value = lstSourceData.ListCount Flag = "" lstSourceData.ListIndex = -1 Application.EnableEvents = True End If End If End Sub

Private Sub cmdSourceDataediy_Click

If Flag = "EDIT" Then Call AddOREditGroup txtSourceData.Text = "" cmdSourceDataediy.Caption = "Edit" Flag = " "

ElseIf lstSourceData.ListIndex >= 0 Then txtSourceData.Text = lstSourceData.Text 'lstSourceData.RemoveItem lstSourceData.ListIndex Flag = "EDIT" cmdSourceDataediy.Caption = "Replace" 'Call AddOREditGroup 'Application.EnableEvents = False 'lstSourceData.ListIndex = -1 'Application.EnableEvents = True

Else MsgBox "Select item to edit", vbInformation + vbOKOnly, mConstants.sToolName

End If lblSourcedatacount.Caption = "Number of source datasets entered - " & lstSourceData.ListCount Sourcedata.Cells(1, 3).Value = lstSourceData.ListCount End Sub

Sub AddOREditGroup Dim StartRange As Integer Dim ListID As Integer ListID = -1

If Flag = "ADD" Then ListID = lstSourceData.ListCount ElseIf Flag = "EDIT" Then ListID = lstSourceData.ListIndex End If   If ListID <> -1 Then StartRange = ListID + 1 End If Sourcedata.Cells(StartRange, 2).Value = txtSourceData.Text

If Flag = "ADD" Then Maxsourcedata = lstSourceData.ListCount + 1

Else Maxsourcedata = lstSourceData.ListCount

End If

Call RefreshGroupList lblSourcedatacount.Caption = "Number of source datasets entered - " & lstSourceData.ListCount Sourcedata.Cells(1, 3).Value = lstSourceData.ListCount End Sub

Sub RefreshGroupList

lstSourceData.Clear

For i = 1 To Maxsourcedata

If Trim(Sourcedata.Cells(i, 2).Value) <> "" Then lstSourceData.AddItem (Sourcedata.Cells(i, 2).Value) End If

Next

End Sub

Sub Refreshform

txtSuiteName.Text = GlobalForm.Cells(1, 2).Value txtSuiteKey.Text = GlobalForm.Cells(2, 2).Value txtRunPeriod.Text = GlobalForm.Cells(3, 2).Value txtUserName.Text = GlobalForm.Cells(5, 2).Value

txtServer.Text = GlobalForm.Cells(7, 2).Value txtPort.Text = GlobalForm.Cells(8, 2).Value txtCostCode.Text = GlobalForm.Cells(9, 2).Value

If GlobalForm.Cells(4, 2).Value = "Mainframe" Then optMainFrame.Value = True If GlobalForm.Cells(4, 2).Value = "Unix" Then optUnix.Value = True

txtStrength.Text = GlobalForm.Cells(10, 2).Value txtStabilty.Text = GlobalForm.Cells(11, 2).Value

If GlobalForm.Cells(12, 2).Value = "No Code" Then chkNoCode.Value = True txtLocation.Text = GlobalForm.Cells(13, 2).Value 'txtCode.Text = GlobalForm.Cells(13, 2).Value If GlobalForm.Cells(15, 2).Value = "Audit" Then optSourceDataAudit.Value = True If GlobalForm.Cells(15, 2).Value = "Monitoring" Then optSourceDataMonitoring.Value = True lblSourcedatacount.Caption = "Number of source datasets entered - " & Sourcedata.Cells(1, 3).Value

End Sub

Private Sub UserForm_Initialize

'If Inp1GDS.Range("A2").Value = "" Then 'MsgBox "Complete filling the Group Details form first", vbOKOnly + vbCritical 'frmGlobalForm.Hide 'Unload frmGlobalForm 'Exit Sub 'End If

Maxsourcedata = Sourcedata.Cells(1, 3).Value Call RefreshGroupList Call Refreshform

End Sub

Private Sub txtSuiteName_Change

Dim lCrc32Value As Long Dim fs As FileSystemObject Dim txsOut As TextStream Dim sOutTextFile As String 'Get the CRC32 value for the suite name On Error Resume Next lCrc32Value = mCRC.InitCrc32 lCrc32Value = mCRC.AddCrc32(txtSuiteName.Value & " - " & Environ("USERNAME"), lCrc32Value) sOutTextFile = "F" & Right(Hex$(mCRC.GetCrc32(lCrc32Value)), 7) txtSuiteKey.Value = sOutTextFile GlobalForm.Cells(2, 2).Value = sOutTextFile End Sub

Private Sub chkNoCode_Click If chkNoCode.Value = "True" Then txtLocation.Value = "" txtLocation.Enabled = False Else txtLocation.Enabled = True End If End Sub

Private Sub cmdRun_Click

Dim sOutTextFile, nameUser As String If Trim$(txtPassword.Value) = vbNullString Then MsgBox "Password required", vbCritical + vbOKOnly, mConstants.sToolName Exit Sub End If   nameUser = UCase(txtUserName.Value) nameServer = UCase(txtServer.Value) 'CREATE SAS CODE sOutTextFile = mTextFile.fnCreateTextFile(nameUser, nameServer) 'FTP AND SUBMIT SAS CODE Call mExecute.sbFtpTextFile(sOutTextFile, nameUser) Unload Me End Sub

""frmGroupView Public Flag, ScrFlag, SegFlag, charFlag, fmtFlag As String Public SelGrpIndx, SelScrIndx, SelSegIndx, SelChrIndx, MaxGroup, MaxScorecard, MaxSegment, MaxCharacteristic As Integer

'ENABLE/DISABLE CHARACTERISTIC FRAME BASED ON CHECKBOX Private Sub chkCSI_Change Call chkCSIVDI End Sub Private Sub chkVDI_Change Call chkCSIVDI End Sub Private Sub chkCSIVDI 'If lstSegmentValue.ListIndex <> -1 Then '   If chkCSI.Value = True Or chkVDI.Value = True Then '       FreCharacteristicVariable.Enabled = True '   End If '    If chkCSI.Value = False And chkVDI.Value = False Then '       FreCharacteristicVariable.Enabled = False '   End If 'End If End Sub

'ADD,EDIT, DELETE BUTTON FUNCTIONALITY FOR GROUP Private Sub cmdAdd_Click If Flag = "EDIT" Then Call AddOREditGroup lstGroupName.Visible = True txtGroupName.Visible = False cmdAdd.Caption = "ADD" cmdEdit.Caption = "EDIT" cmdDelete.Caption = "DELETE" cmdEdit.Enabled = True comboSegmentVariable.Enabled = False Flag = "" 'CHECK THIS 'FreScore.Enabled = True 'FreSegment.Enabled = True txtGroupName.BackColor = &H80000005 comboSegmentVariable.BackColor = &H80000005 Call enableButtons Else If AddGroupCheck Then txtGroupName.Text = "" 'txtSegmentName.Text = "" comboSegmentVariable.Enabled = True comboSegmentVariable.Value = "" cmdAdd.Enabled = False lstGroupName.Visible = False txtGroupName.Visible = True cmdEdit.Caption = "SAVE" cmdDelete.Caption = "CANCEL" Flag = "ADD" FreScore.Enabled = False FreSegment.Enabled = False FreCharacteristicVariable.Enabled = False txtGroupName.BackColor = &HC0FFFF comboSegmentVariable.BackColor = &HC0FFFF Call disableButtons End If   End If End Sub

Private Sub cmdDelete_Click

Dim i, cntRow, cntLoop, startRow, endRow As Integer Dim cntRowC, cntLoopC, startRowC, endRowC As Integer

cmdAdd.Caption = "ADD" cmdEdit.Caption = "EDIT" cmdDelete.Caption = "DELETE" cmdAdd.Enabled = True cmdEdit.Enabled = True

If Not (Flag = "ADD" Or Flag = "EDIT") Then If lstGroupName.ListIndex = -1 Then MsgBox "Select item to edit", vbInformation + vbOKOnly, mConstants.sToolName ElseIf MsgBox("Delete the selected group and all scores in group?", vbQuestion + vbYesNo, mConstants.sToolName) = vbYes Then SheetData.Visible = xlSheetVisible SheetData.Activate SheetData.Range("A" & CalculateCellRow(lstGroupName.ListIndex + 1) & ":AV" & CalculateCellRow(lstGroupName.ListIndex + 2) - 1).Select 'Selection.EntireRow.ClearContents 'SheetData.Range(Selection, Selection.End(xlToRight)).Select Selection.ClearContents

For j = lstGroupName.ListIndex + 2 To lstGroupName.ListCount 'Copy and paste the data SheetData.Range("A" & CalculateCellRow(j) & ":AV" & CalculateCellRow(j + 1) - 1).Select 'SheetData.Range(Selection, Selection.End(xlToRight)).Select Selection.Copy SheetData.Range("A" & CalculateCellRow(j - 1)).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False Application.CutCopyMode = False SheetData.Range("A" & CalculateCellRow(j - 1)).Select 'Delete the data SheetData.Range("A" & CalculateCellRow(j) & ":AV" & CalculateCellRow(j + 1) - 1).Select 'SheetData.Range(Selection, Selection.End(xlToRight)).Select Selection.ClearContents SheetData.Range("A" & CalculateCellRow(j - 1)).Select Next 'DELETE DATA FROM "PSI DETAILS" TAB Call sortSegmentSheets Inp3PSI.Visible = xlSheetVisible Inp3PSI.Activate cntRow = WorksheetFunction.CountA(Inp3PSI.Range("A:A")) cntLoop = 0 For i = 2 To cntRow If Inp3PSI.Cells(i, 2).Value = comboSegmentVariable.Value Then If cntLoop = 0 Then startRow = i                   End If                    endRow = i                    cntLoop = cntLoop + 1 End If           Next i            If (startRow > 0 And endRow > 0) Then Inp3PSI.Range("A" & startRow & ":L" & endRow).Select Selection.ClearContents Inp3PSI.Range("A" & endRow + 1 & ":L" & cntRow).Select Selection.Cut Inp3PSI.Range("A" & startRow).Select ActiveSheet.Paste Inp3PSI.Range("A" & startRow).Select End If           'DELETE DATA FROM "CHARACTERISTIC DETAILS" TAB Call sortCharacteristicSheets Inp4CSI.Visible = xlSheetVisible Inp4CSI.Activate cntRowC = WorksheetFunction.CountA(Inp4CSI.Range("A:A")) cntLoopC = 0 For i = 2 To cntRowC If Inp4CSI.Cells(i, 2).Value = comboSegmentVariable.Value Then If cntLoopC = 0 Then startRowC = i                   End If                    endRowC = i                    cntLoopC = cntLoopC + 1 End If           Next i            If (startRowC > 0 And endRowC > 0) Then Inp4CSI.Range("A" & startRowC & ":Q" & endRowC).Select Selection.ClearContents Inp4CSI.Range("A" & endRowC + 1 & ":Q" & cntRowC).Select Selection.Cut Inp4CSI.Range("A" & startRowC).Select ActiveSheet.Paste Inp4CSI.Range("A" & startRowC).Select End If           'UNCOMMENT LATER SheetData.Visible = xlSheetHidden Inp3PSI.Visible = xlSheetHidden Inp4CSI.Visible = xlSheetHidden Inp0Button.Activate End If   End If Call RefreshGroupList(lstGroupName.ListIndex - 1) Flag = "" lstGroupName.Visible = True txtGroupName.Visible = False

txtGroupName.BackColor = &H80000005 comboSegmentVariable.BackColor = &H80000005 comboSegmentVariable.Enabled = False

Call enableButtons End Sub

Private Sub CmdEdit_Click If Flag = "ADD" Then Call AddOREditGroup lstGroupName.Visible = True txtGroupName.Visible = False cmdEdit.Caption = "EDIT" cmdDelete.Caption = "DELETE" cmdAdd.Enabled = True Flag = "" cmdAdd.Enabled = True comboSegmentVariable.Enabled = False 'CHECK THIS 'FreScore.Enabled = True 'FreSegment.Enabled = True

txtGroupName.BackColor = &H80000005 comboSegmentVariable.BackColor = &H80000005 Else If lstGroupName.ListIndex = -1 Then MsgBox "Select item to edit", vbInformation + vbOKOnly, mConstants.sToolName Exit Sub End If   Call EditCurrentItemGroup cmdEdit.Enabled = False Flag = "EDIT" lstGroupName.Visible = False txtGroupName.Visible = True cmdAdd.Caption = "SAVE" cmdDelete.Caption = "CANCEL" comboSegmentVariable.Enabled = True FreScore.Enabled = False FreSegment.Enabled = False FreCharacteristicVariable.Enabled = False txtGroupName.BackColor = &HFFFFC0 comboSegmentVariable.BackColor = &HFFFFC0 Call disableButtons End If End Sub

Sub EditCurrentItemGroup txtGroupName.Text = lstGroupName.Text End Sub

Private Sub lstGroupName_Change Dim k As Integer For k = 0 To lstGroupName.ListCount - 1 If lstGroupName.Selected(k) = True Then SelGrpIndx = k           txtGroupName.Text = lstGroupName.Selected(k) 'txtGroupName.Text = lstGroupName.List(k) End If   Next RefreshSegmentData RefreshScoreList RefreshScoreData RefreshSegmentList RefreshSegmentListData RefreshCharacteristicList If lstGroupName.ListIndex >= 0 Then Call RefreshBinsPSI Call RefreshBinsCSI End If End Sub

Function AddGroupCheck As Boolean AddGroupCheck = True If lstGroupName.ListCount = MaxGroup Then MsgBox "Cannot add more than " & MaxGroup & " groups", vbInformation + vbOKOnly, mConstants.sToolName AddGroupCheck = False Exit Function End If End Function

Sub AddOREditGroup Dim StartRange As Integer Dim ListID As Integer ListID = -1

If Flag = "ADD" Then ListID = lstGroupName.ListCount ElseIf Flag = "EDIT" Then ListID = lstGroupName.ListIndex End If   If ListID <> -1 Then StartRange = CalculateCellRow((ListID + 1)) End If   If Len(Trim(txtGroupName.Text)) < 1 Then MsgBox "Required fields missing", vbCritical + vbOKOnly, mConstants.sToolName Exit Sub End If

ListID = addSegmentData(StartRange) Call RefreshGroupList(ListID)

End Sub

Function addSegmentData(ByVal StartRange As Integer) As Integer '   If Len(Trim(txtSegmentName.Text)) < 1 Or Len(Trim(comboSegmentVariable.Value)) < 1 Then '       MsgBox "Segment name and variable for group required", vbCritical + vbOKOnly, mConstants.sToolName If Len(Trim(comboSegmentVariable.Value)) < 1 Then MsgBox "Segment variable for group required", vbCritical + vbOKOnly, mConstants.sToolName If lstGroupName.ListIndex <= 0 Then addSegmentData = lstGroupName.ListIndex Else addSegmentData = lstGroupName.ListIndex - 1 End If       Exit Function Else SheetData.Visible = xlSheetVisible SheetData.Cells(StartRange, 1).Value = UCase(txtGroupName.Text) SheetData.Cells(StartRange, 2).Value = UCase(txtGroupName.Text) 'SheetData.Cells(StartRange, 2).Value = UCase(txtSegmentName.Text) SheetData.Cells(StartRange, 3).Value = UCase(comboSegmentVariable.Value) addSegmentData = lstGroupName.ListIndex SheetData.Visible = xlSheetHidden End If End Function

'ADD,EDIT, DELETE BUTTON FUNCTIONALITY FOR SCORE Private Sub cmdScoreADD_Click

If ScrFlag = "EDIT" Then

If Len(Trim(comboScoreVariable.Value)) < 1 Then MsgBox "Score variable for score required", vbCritical + vbOKOnly, mConstants.sToolName Exit Sub ElseIf Len(Trim(comboBad.Value)) < 1 Then MsgBox "Bad definition for score required", vbCritical + vbOKOnly, mConstants.sToolName Exit Sub End If       Call AddOREditScore lstScoreName.Visible = True txtScoreName.Visible = False cmdScoreAdd.Caption = "ADD" cmdScoreEdit.Caption = "EDIT" cmdScoreDelete.Caption = "DELETE" cmdScoreEdit.Enabled = True ScrFlag = "" 'CHECK THIS FreGroupLevel.Enabled = True 'FreSegment.Enabled = True comboScoreVariable.Enabled = False comboBad.Enabled = False txtScoreName.BackColor = &H80000005 comboScoreVariable.BackColor = &H80000005 comboBad.BackColor = &H80000005 freScoreExcludeMissing.BackColor = &H8000000F FrePeriodYesNo.BackColor = &H8000000F FreAlignmentYesNo.BackColor = &H8000000F txtScoreLowerBound.BackColor = &H80000005 txtScoreUpperBound.BackColor = &H80000005 txtBadRate.BackColor = &H80000005 txtAlignmentBaseScore.BackColor = &H80000005 txtPDO.BackColor = &H80000005 txtOddsAtBaseScore.BackColor = &H80000005 chkPSI.BackColor = &H8000000F chkCSI.BackColor = &H8000000F chkVDI.BackColor = &H8000000F chkKS.BackColor = &H8000000F chkGini.BackColor = &H8000000F chkDivergence.BackColor = &H8000000F chkBadRate.BackColor = &H8000000F chkGainsTable.BackColor = &H8000000F chkAvgScoreGoods.BackColor = &H8000000F chkAvgScoreBads.BackColor = &H8000000F 'chkCharacLvlBadRt.BackColor = &H8000000F chkAlignmentTable.BackColor = &H8000000F chkOddsAtBaseScore.BackColor = &H8000000F chkPDO.BackColor = &H8000000F txtImplementationDate.BackColor = &H80000005 txtPSIBenchmarkPeriod.BackColor = &H80000005 txtStrengthBenchmarkPeriod.BackColor = &H80000005 txtPSICurrentPeriod.BackColor = &H80000005 txtStrengthCurrentPeriod.BackColor = &H80000005 txtCSIBenchmarkPeriod.BackColor = &H80000005 txtCSICurrentPeriod.BackColor = &H80000005 txtAlignmentBenchmarkPeriod.BackColor = &H80000005 txtAlignmentCurrentPeriod.BackColor = &H80000005 txtAlignmentBaseScore.BackColor = &H80000005 txtPDO.BackColor = &H80000005 txtOddsAtBaseScore.BackColor = &H80000005 Call enableButtons Else If AddScoreCheck Then txtScoreName.Text = "" Call defaultScoreData cmdScoreAdd.Enabled = False lstScoreName.Visible = False txtScoreName.Visible = True cmdScoreEdit.Caption = "SAVE" cmdScoreDelete.Caption = "CANCEL" ScrFlag = "ADD" FreGroupLevel.Enabled = False FreSegment.Enabled = False FreCharacteristicVariable.Enabled = False If optSameYes.Value = True Then FrePeriod.Enabled = True End If           If optAlignYes.Value = True Then FreAlignmentParameters.Enabled = True End If           FreMetrics.Enabled = True 'FreBenchmark.Enabled = True 'FrePeriod.Enabled = True FreScoreData.Enabled = True 'freScoreExcludeMissing.Enabled = True 'FrePeriodYesNo.Enabled = True comboScoreVariable.Enabled = True comboBad.Enabled = True txtScoreName.BackColor = &HC0FFFF comboScoreVariable.BackColor = &HC0FFFF comboBad.BackColor = &HC0FFFF freScoreExcludeMissing.BackColor = &HC0FFFF FrePeriodYesNo.BackColor = &HC0FFFF FreAlignmentYesNo.BackColor = &HC0FFFF 'txtScoreLowerBound.BackColor = &HC0FFFF 'txtScoreUpperBound.BackColor = &HC0FFFF txtScoreLowerBound.BackColor = &H8080FF txtScoreUpperBound.BackColor = &H8080FF txtBadRate.BackColor = &HC0FFFF chkPSI.BackColor = &HC0FFFF chkCSI.BackColor = &HC0FFFF chkVDI.BackColor = &HC0FFFF chkKS.BackColor = &HC0FFFF chkGini.BackColor = &HC0FFFF chkDivergence.BackColor = &HC0FFFF chkBadRate.BackColor = &HC0FFFF chkGainsTable.BackColor = &HC0FFFF chkAvgScoreGoods.BackColor = &HC0FFFF chkAvgScoreBads.BackColor = &HC0FFFF 'chkCharacLvlBadRt.BackColor = &HC0FFFF chkAlignmentTable.BackColor = &HC0FFFF chkOddsAtBaseScore.BackColor = &HC0FFFF chkPDO.BackColor = &HC0FFFF If optSameYes.Value = True Then txtImplementationDate.BackColor = &HC0FFFF txtPSIBenchmarkPeriod.BackColor = &HC0FFFF txtStrengthBenchmarkPeriod.BackColor = &HC0FFFF txtPSICurrentPeriod.BackColor = &HC0FFFF txtStrengthCurrentPeriod.BackColor = &HC0FFFF txtCSIBenchmarkPeriod.BackColor = &HC0FFFF txtCSICurrentPeriod.BackColor = &HC0FFFF txtAlignmentBenchmarkPeriod.BackColor = &HC0FFFF txtAlignmentCurrentPeriod.BackColor = &HC0FFFF End If           If optAlignYes.Value = True Then txtAlignmentBaseScore.BackColor = &HC0FFFF txtPDO.BackColor = &HC0FFFF txtOddsAtBaseScore.BackColor = &HC0FFFF End If           Call disableButtons End If   End If End Sub

Private Sub CmdScoreDelete_Click

Dim i, cntRow, cntLoop, startRow, endRow As Integer Dim cntRowC, cntLoopC, startRowC, endRowC As Integer

cmdScoreAdd.Caption = "ADD" cmdScoreEdit.Caption = "EDIT" cmdScoreDelete.Caption = "DELETE" cmdScoreAdd.Enabled = True cmdScoreEdit.Enabled = True

If Not (ScrFlag = "ADD" Or ScrFlag = "EDIT") Then If lstScoreName.ListIndex = -1 Then MsgBox "Select item to edit", vbInformation + vbOKOnly, mConstants.sToolName ElseIf MsgBox("Delete selected score and associated data?", vbQuestion + vbYesNo, mConstants.sToolName) = vbYes Then SheetData.Visible = xlSheetVisible SheetData.Activate SheetData.Range("D" & CalculateCellRowScore(lstGroupName.ListIndex + 1, lstScoreName.ListIndex + 1) & ":AV" & CalculateCellRowScore(lstGroupName.ListIndex + 1, lstScoreName.ListIndex + 2) - 1).Select 'Selection.EntireRow.ClearContents 'SheetData.Range(Selection, Selection.End(xlToRight)).Select Selection.ClearContents For j = lstScoreName.ListIndex + 2 To lstScoreName.ListCount 'Copy and paste the data SheetData.Range("D" & CalculateCellRowScore(lstGroupName.ListIndex + 1, j) & ":AV" & CalculateCellRowScore(lstGroupName.ListIndex + 1, j + 1) - 1).Select 'SheetData.Range(Selection, Selection.End(xlToRight)).Select Selection.Copy SheetData.Range("D" & CalculateCellRowScore(lstGroupName.ListIndex + 1, j - 1) & ":AV" & CalculateCellRowScore(lstGroupName.ListIndex + 1, j) - 1).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False Application.CutCopyMode = False SheetData.Range("D" & CalculateCellRowScore(lstGroupName.ListIndex + 1, j - 1)).Select 'Delete the data SheetData.Range("D" & CalculateCellRowScore(lstGroupName.ListIndex + 1, j) & ":AV" & CalculateCellRowScore(lstGroupName.ListIndex + 1, j + 1) - 1).Select 'SheetData.Range(Selection, Selection.End(xlToRight)).Select Selection.ClearContents SheetData.Range("D" & CalculateCellRowScore(lstGroupName.ListIndex + 1, j - 1)).Select Next 'DELETE DATA FROM "PSI DETAILS" TAB Call sortSegmentSheets Inp3PSI.Visible = xlSheetVisible Inp3PSI.Activate cntRow = WorksheetFunction.CountA(Inp3PSI.Range("A:A")) cntLoop = 0 For i = 2 To cntRow If Inp3PSI.Cells(i, 1).Value = comboScoreVariable.Value Then If Inp3PSI.Cells(i, 2).Value = comboSegmentVariable.Value Then If cntLoop = 0 Then startRow = i                       End If                        endRow = i                        cntLoop = cntLoop + 1 End If               End If            Next i            If (startRow > 0 And endRow > 0) Then Inp3PSI.Range("A" & startRow & ":L" & endRow).Select Selection.ClearContents Inp3PSI.Range("A" & endRow + 1 & ":L" & cntRow).Select Selection.Cut Inp3PSI.Range("A" & startRow).Select ActiveSheet.Paste Inp3PSI.Range("A" & startRow).Select End If           'DELETE DATA FROM "CHARACTERISTIC DETAILS" TAB Call sortCharacteristicSheets Inp4CSI.Visible = xlSheetVisible Inp4CSI.Activate cntRowC = WorksheetFunction.CountA(Inp4CSI.Range("A:A")) cntLoopC = 0 For i = 2 To cntRowC If Inp4CSI.Cells(i, 1).Value = comboScoreVariable.Value Then If Inp4CSI.Cells(i, 2).Value = comboSegmentVariable.Value Then If cntLoopC = 0 Then startRowC = i                       End If                        endRowC = i                        cntLoopC = cntLoopC + 1 End If               End If            Next i            If (startRowC > 0 And endRowC > 0) Then Inp4CSI.Range("A" & startRowC & ":Q" & endRowC).Select Selection.ClearContents Inp4CSI.Range("A" & endRowC + 1 & ":Q" & cntRowC).Select Selection.Cut Inp4CSI.Range("A" & startRowC).Select ActiveSheet.Paste Inp4CSI.Range("A" & startRowC).Select End If       'UNCOMMENT LATER SheetData.Visible = xlSheetHidden Inp3PSI.Visible = xlSheetHidden Inp4CSI.Visible = xlSheetHidden Inp0Button.Activate End If   End If Call RefreshScoreList ScrFlag = "" lstScoreName.Visible = True txtScoreName.Visible = False

FreGroupLevel.Enabled = True

comboScoreVariable.Enabled = False comboBad.Enabled = False

txtScoreName.BackColor = &H80000005 comboScoreVariable.BackColor = &H80000005 comboBad.BackColor = &H80000005 freScoreExcludeMissing.BackColor = &H8000000F FrePeriodYesNo.BackColor = &H8000000F FreAlignmentYesNo.BackColor = &H8000000F txtScoreLowerBound.BackColor = &H80000005 txtScoreUpperBound.BackColor = &H80000005 txtBadRate.BackColor = &H80000005

txtAlignmentBaseScore.BackColor = &H80000005 txtPDO.BackColor = &H80000005 txtOddsAtBaseScore.BackColor = &H80000005

chkPSI.BackColor = &H8000000F chkCSI.BackColor = &H8000000F chkVDI.BackColor = &H8000000F chkKS.BackColor = &H8000000F chkGini.BackColor = &H8000000F chkDivergence.BackColor = &H8000000F chkBadRate.BackColor = &H8000000F chkGainsTable.BackColor = &H8000000F chkAvgScoreGoods.BackColor = &H8000000F chkAvgScoreBads.BackColor = &H8000000F 'chkCharacLvlBadRt.BackColor = &H8000000F chkAlignmentTable.BackColor = &H8000000F chkOddsAtBaseScore.BackColor = &H8000000F chkPDO.BackColor = &H8000000F

txtImplementationDate.BackColor = &H80000005 txtPSIBenchmarkPeriod.BackColor = &H80000005 txtStrengthBenchmarkPeriod.BackColor = &H80000005 txtPSICurrentPeriod.BackColor = &H80000005 txtStrengthCurrentPeriod.BackColor = &H80000005

txtCSIBenchmarkPeriod.BackColor = &H80000005 txtCSICurrentPeriod.BackColor = &H80000005 txtAlignmentBenchmarkPeriod.BackColor = &H80000005 txtAlignmentCurrentPeriod.BackColor = &H80000005 txtAlignmentBaseScore.BackColor = &H80000005 txtPDO.BackColor = &H80000005 txtOddsAtBaseScore.BackColor = &H80000005 Call enableButtons End Sub

Private Sub CmdScoreEdit_Click

If ScrFlag = "ADD" Then

If Len(Trim(comboScoreVariable.Value)) < 1 Then MsgBox "Score variable for score required", vbCritical + vbOKOnly, mConstants.sToolName Exit Sub ElseIf Len(Trim(comboBad.Value)) < 1 Then MsgBox "Bad definition for score required", vbCritical + vbOKOnly, mConstants.sToolName Exit Sub End If

Call AddOREditScore lstScoreName.Visible = True txtScoreName.Visible = False cmdScoreEdit.Caption = "EDIT" cmdScoreDelete.Caption = "DELETE" cmdScoreAdd.Enabled = True ScrFlag = "" cmdScoreAdd.Enabled = True 'CHECK THIS FreGroupLevel.Enabled = True 'FreSegment.Enabled = True comboScoreVariable.Enabled = False comboBad.Enabled = False txtScoreName.BackColor = &H80000005 comboScoreVariable.BackColor = &H80000005 comboBad.BackColor = &H80000005 freScoreExcludeMissing.BackColor = &H8000000F FrePeriodYesNo.BackColor = &H8000000F FreAlignmentYesNo.BackColor = &H8000000F txtScoreLowerBound.BackColor = &H80000005 txtScoreUpperBound.BackColor = &H80000005 txtBadRate.BackColor = &H80000005 txtAlignmentBaseScore.BackColor = &H80000005 txtPDO.BackColor = &H80000005 txtOddsAtBaseScore.BackColor = &H80000005 chkPSI.BackColor = &H8000000F chkCSI.BackColor = &H8000000F chkVDI.BackColor = &H8000000F chkKS.BackColor = &H8000000F chkGini.BackColor = &H8000000F chkDivergence.BackColor = &H8000000F chkBadRate.BackColor = &H8000000F chkGainsTable.BackColor = &H8000000F chkAvgScoreGoods.BackColor = &H8000000F chkAvgScoreBads.BackColor = &H8000000F 'chkCharacLvlBadRt.BackColor = &H8000000F chkAlignmentTable.BackColor = &H8000000F chkOddsAtBaseScore.BackColor = &H8000000F chkPDO.BackColor = &H8000000F txtImplementationDate.BackColor = &H80000005 txtPSIBenchmarkPeriod.BackColor = &H80000005 txtStrengthBenchmarkPeriod.BackColor = &H80000005 txtPSICurrentPeriod.BackColor = &H80000005 txtStrengthCurrentPeriod.BackColor = &H80000005 txtCSIBenchmarkPeriod.BackColor = &H80000005 txtCSICurrentPeriod.BackColor = &H80000005 txtAlignmentBenchmarkPeriod.BackColor = &H80000005 txtAlignmentCurrentPeriod.BackColor = &H80000005 txtAlignmentBaseScore.BackColor = &H80000005 txtPDO.BackColor = &H80000005 txtOddsAtBaseScore.BackColor = &H80000005

Call enableButtons Else If lstScoreName.ListIndex = -1 Then MsgBox "Select item to edit", vbInformation + vbOKOnly, mConstants.sToolName Exit Sub End If   Call EditCurrentItemScore cmdScoreEdit.Enabled = False ScrFlag = "EDIT" lstScoreName.Visible = False txtScoreName.Visible = True cmdScoreAdd.Caption = "SAVE" cmdScoreDelete.Caption = "CANCEL" FreGroupLevel.Enabled = False FreSegment.Enabled = False FreCharacteristicVariable.Enabled = False FreMetrics.Enabled = True 'FreBenchmark.Enabled = True If optSameYes.Value = True Then FrePeriod.Enabled = True End If   If optAlignYes.Value = True Then FreAlignmentParameters.Enabled = True End If   FreScoreData.Enabled = True 'freScoreExcludeMissing.Enabled = True 'FrePeriodYesNo.Enabled = True comboScoreVariable.Enabled = True comboBad.Enabled = True txtScoreName.BackColor = &HFFFFC0 comboScoreVariable.BackColor = &HFFFFC0 comboBad.BackColor = &HFFFFC0 freScoreExcludeMissing.BackColor = &HFFFFC0 FrePeriodYesNo.BackColor = &HFFFFC0 FreAlignmentYesNo.BackColor = &HFFFFC0 'txtScoreLowerBound.BackColor = &HFFFFC0 'txtScoreUpperBound.BackColor = &HFFFFC0 txtScoreLowerBound.BackColor = &H8080FF txtScoreUpperBound.BackColor = &H8080FF txtBadRate.BackColor = &HFFFFC0 chkPSI.BackColor = &HFFFFC0 chkCSI.BackColor = &HFFFFC0 chkVDI.BackColor = &HFFFFC0 chkKS.BackColor = &HFFFFC0 chkGini.BackColor = &HFFFFC0 chkDivergence.BackColor = &HFFFFC0 chkBadRate.BackColor = &HFFFFC0 chkGainsTable.BackColor = &HFFFFC0 chkAvgScoreGoods.BackColor = &HFFFFC0 chkAvgScoreBads.BackColor = &HFFFFC0 'chkCharacLvlBadRt.BackColor = &HFFFFC0 chkAlignmentTable.BackColor = &HFFFFC0 chkOddsAtBaseScore.BackColor = &HFFFFC0 chkPDO.BackColor = &HFFFFC0 If optSameYes.Value = True Then txtImplementationDate.BackColor = &HFFFFC0 txtPSIBenchmarkPeriod.BackColor = &HFFFFC0 txtStrengthBenchmarkPeriod.BackColor = &HFFFFC0 txtPSICurrentPeriod.BackColor = &HFFFFC0 txtStrengthCurrentPeriod.BackColor = &HFFFFC0 txtCSIBenchmarkPeriod.BackColor = &HFFFFC0 txtCSICurrentPeriod.BackColor = &HFFFFC0 txtAlignmentBenchmarkPeriod.BackColor = &HFFFFC0 txtAlignmentCurrentPeriod.BackColor = &HFFFFC0 End If   If optAlignYes.Value = True Then txtAlignmentBaseScore.BackColor = &HFFFFC0 txtPDO.BackColor = &HFFFFC0 txtOddsAtBaseScore.BackColor = &HFFFFC0 End If   Call disableButtons End If

End Sub

Sub EditCurrentItemScore 'txtScoreName.Text = lstScoreName.Text txtScoreName.Text = lstScoreName.List(SelScrIndx) End Sub

Private Sub lstScoreName_Change Dim k As Integer fmtFlag = "PSI" For k = 0 To lstScoreName.ListCount - 1 If lstScoreName.Selected(k) = True Then SelScrIndx = k           txtScoreName.Text = lstScoreName.Selected(k) 'txtScoreName.Text = lstScoreName.List(k) End If   Next RefreshScoreData RefreshSegmentList RefreshSegmentListData RefreshCharacteristicList If lstSegmentValue.ListIndex >= 0 Then Call RefreshBinsPSI Call RefreshBinsCSI End If End Sub

Function AddScoreCheck As Boolean AddScoreCheck = True If lstScoreName.ListCount = MaxScorecard Then MsgBox "Cannot add more than " & MaxScorecard & " scores", vbInformation + vbOKOnly, mConstants.sToolName AddScoreCheck = False Exit Function End If End Function

Sub AddOREditScore Dim StartRange As Integer Dim ListID As Integer ListID = -1

If ScrFlag = "ADD" Then ListID = lstScoreName.ListCount ElseIf ScrFlag = "EDIT" Then ListID = lstScoreName.ListIndex End If   If ListID <> -1 Then StartRange = CalculateCellRowScore(lstGroupName.ListIndex + 1, ListID + 1) End If   If Len(Trim(txtScoreName.Text)) < 1 Then MsgBox "Required fields missing", vbCritical + vbOKOnly, mConstants.sToolName Exit Sub End If 'CHECK THIS 'SheetData.Cells(StartRange, 4).Value = txtScoreName.Text addScoreData (StartRange)

Call RefreshScoreList Call RefreshScoreData

End Sub

'ADD SCORE LEVEL DATA Sub addScoreData(ByVal StartRange As Integer) SheetData.Visible = xlSheetVisible 'CHECK THIS SheetData.Cells(StartRange, 4).Value = UCase(txtScoreName.Text) SheetData.Cells(StartRange, 5).Value = UCase(comboScoreVariable.Value) SheetData.Cells(StartRange, 6).Value = UCase(comboBad.Value) SheetData.Cells(StartRange, 7).Value = txtScoreLowerBound.Text SheetData.Cells(StartRange, 8).Value = txtScoreUpperBound.Text SheetData.Cells(StartRange, 9).Value = optScoreExcludeMissingYes.Value SheetData.Cells(StartRange, 10).Value = chkPSI.Value SheetData.Cells(StartRange, 11).Value = chkVDI.Value SheetData.Cells(StartRange, 12).Value = chkCSI.Value SheetData.Cells(StartRange, 13).Value = chkKS.Value SheetData.Cells(StartRange, 14).Value = chkGini.Value SheetData.Cells(StartRange, 15).Value = chkDivergence.Value SheetData.Cells(StartRange, 16).Value = chkBadRate.Value SheetData.Cells(StartRange, 17).Value = chkGainsTable.Value SheetData.Cells(StartRange, 18).Value = chkAvgScoreGoods.Value SheetData.Cells(StartRange, 19).Value = chkAvgScoreBads.Value SheetData.Cells(StartRange, 20).Value = chkCharacLvlBadRt.Value SheetData.Cells(StartRange, 21).Value = chkOddsAtBaseScore.Value SheetData.Cells(StartRange, 22).Value = chkPDO.Value SheetData.Cells(StartRange, 23).Value = chkAlignmentTable.Value SheetData.Cells(StartRange, 24).Value = txtAlignmentBaseScore.Text SheetData.Cells(StartRange, 25).Value = txtOddsAtBaseScore.Text SheetData.Cells(StartRange, 26).Value = txtPDO.Text SheetData.Cells(StartRange, 47).Value = optSameYes.Value SheetData.Cells(StartRange, 48).Value = optAlignYes.Value 'If optSameYes.Value = True Then SheetData.Cells(StartRange, 27).Value = "'" & UCase(txtImplementationDate.Text) SheetData.Cells(StartRange, 28).Value = "'" & UCase(txtPSIBenchmarkPeriod.Text) SheetData.Cells(StartRange, 29).Value = "'" & UCase(txtCSIBenchmarkPeriod.Text) SheetData.Cells(StartRange, 30).Value = "'" & UCase(txtStrengthBenchmarkPeriod.Text) SheetData.Cells(StartRange, 31).Value = "'" & UCase(txtAlignmentBenchmarkPeriod.Text) SheetData.Cells(StartRange, 32).Value = "'" & UCase(txtPSICurrentPeriod.Text) SheetData.Cells(StartRange, 33).Value = "'" & UCase(txtCSICurrentPeriod.Text) SheetData.Cells(StartRange, 34).Value = "'" & UCase(txtStrengthCurrentPeriod.Text) SheetData.Cells(StartRange, 35).Value = "'" & UCase(txtAlignmentCurrentPeriod.Text) 'End If   SheetData.Visible = xlSheetHidden End Sub

'ENABLE/DISABLE PERIOD FRAME BASED ON RADIOBUTTON SELECTION Private Sub optSameYes_Change If (ScrFlag = "ADD" Or ScrFlag = "EDIT") Then If optSameYes.Value = False Then FrePeriod.Enabled = False StartRange = CalculateCellRowSegment(SelGrpIndx + 1, SelScrIndx + 1, SelSegIndx + 1) txtImplementationDate.Text = SheetData.Cells(StartRange, 27).Value txtPSIBenchmarkPeriod.Text = SheetData.Cells(StartRange, 28).Value txtCSIBenchmarkPeriod.Text = SheetData.Cells(StartRange, 29).Value txtStrengthBenchmarkPeriod.Text = SheetData.Cells(StartRange, 30).Value txtAlignmentBenchmarkPeriod.Text = SheetData.Cells(StartRange, 31).Value txtPSICurrentPeriod.Text = SheetData.Cells(StartRange, 32).Value txtCSICurrentPeriod.Text = SheetData.Cells(StartRange, 33).Value txtStrengthCurrentPeriod.Text = SheetData.Cells(StartRange, 34).Value txtAlignmentCurrentPeriod.Text = SheetData.Cells(StartRange, 35).Value txtImplementationDate.BackColor = &H80000005 txtPSIBenchmarkPeriod.BackColor = &H80000005 txtStrengthBenchmarkPeriod.BackColor = &H80000005 txtPSICurrentPeriod.BackColor = &H80000005 txtStrengthCurrentPeriod.BackColor = &H80000005 txtCSIBenchmarkPeriod.BackColor = &H80000005 txtAlignmentBenchmarkPeriod.BackColor = &H80000005 txtCSICurrentPeriod.BackColor = &H80000005 txtAlignmentCurrentPeriod.BackColor = &H80000005 Else FrePeriod.Enabled = True StartRange = CalculateCellRowScore(SelGrpIndx + 1, SelScrIndx + 1) txtImplementationDate.Text = SheetData.Cells(StartRange, 27).Value txtPSIBenchmarkPeriod.Text = SheetData.Cells(StartRange, 28).Value txtCSIBenchmarkPeriod.Text = SheetData.Cells(StartRange, 29).Value txtStrengthBenchmarkPeriod.Text = SheetData.Cells(StartRange, 30).Value txtAlignmentBenchmarkPeriod.Text = SheetData.Cells(StartRange, 31).Value txtPSICurrentPeriod.Text = SheetData.Cells(StartRange, 32).Value txtCSICurrentPeriod.Text = SheetData.Cells(StartRange, 33).Value txtStrengthCurrentPeriod.Text = SheetData.Cells(StartRange, 34).Value txtAlignmentCurrentPeriod.Text = SheetData.Cells(StartRange, 35).Value If ScrFlag = "ADD" Then txtImplementationDate.BackColor = &HC0FFFF txtPSIBenchmarkPeriod.BackColor = &HC0FFFF txtStrengthBenchmarkPeriod.BackColor = &HC0FFFF txtPSICurrentPeriod.BackColor = &HC0FFFF txtStrengthCurrentPeriod.BackColor = &HC0FFFF txtCSIBenchmarkPeriod.BackColor = &HC0FFFF txtAlignmentBenchmarkPeriod.BackColor = &HC0FFFF txtCSICurrentPeriod.BackColor = &HC0FFFF txtAlignmentCurrentPeriod.BackColor = &HC0FFFF ElseIf ScrFlag = "EDIT" Then txtImplementationDate.BackColor = &HFFFFC0 txtPSIBenchmarkPeriod.BackColor = &HFFFFC0 txtStrengthBenchmarkPeriod.BackColor = &HFFFFC0 txtPSICurrentPeriod.BackColor = &HFFFFC0 txtStrengthCurrentPeriod.BackColor = &HFFFFC0 txtCSIBenchmarkPeriod.BackColor = &HFFFFC0 txtAlignmentBenchmarkPeriod.BackColor = &HFFFFC0 txtCSICurrentPeriod.BackColor = &HFFFFC0 txtAlignmentCurrentPeriod.BackColor = &HFFFFC0 End If       End If    End If End Sub

'ENABLE/DISABLE ALIGNMENT FRAME BASED ON RADIOBUTTON SELECTION Private Sub optAlignYes_Change If (ScrFlag = "ADD" Or ScrFlag = "EDIT") Then If optAlignYes.Value = False Then FreAlignmentParameters.Enabled = False StartRange = CalculateCellRowSegment(SelGrpIndx + 1, SelScrIndx + 1, SelSegIndx + 1) txtAlignmentBaseScore.Text = SheetData.Cells(StartRange, 24).Value txtPDO.Text = SheetData.Cells(StartRange, 25).Value txtOddsAtBaseScore.Text = SheetData.Cells(StartRange, 26).Value txtAlignmentBaseScore.BackColor = &H80000005 txtPDO.BackColor = &H80000005 txtOddsAtBaseScore.BackColor = &H80000005 Else FreAlignmentParameters.Enabled = True StartRange = CalculateCellRowScore(SelGrpIndx + 1, SelScrIndx + 1) txtAlignmentBaseScore.Text = SheetData.Cells(StartRange, 24).Value txtPDO.Text = SheetData.Cells(StartRange, 25).Value txtOddsAtBaseScore.Text = SheetData.Cells(StartRange, 26).Value If ScrFlag = "ADD" Then txtAlignmentBaseScore.BackColor = &HC0FFFF txtPDO.BackColor = &HC0FFFF txtOddsAtBaseScore.BackColor = &HC0FFFF ElseIf ScrFlag = "EDIT" Then txtAlignmentBaseScore.BackColor = &HFFFFC0 txtPDO.BackColor = &HFFFFC0 txtOddsAtBaseScore.BackColor = &HFFFFC0 End If       End If    End If End Sub

'ADD,EDIT, DELETE BUTTON FUNCTIONALITY FOR SEGMENT Private Sub cmdSegmentAdd_Click If SegFlag = "EDIT" Then Call AddOREditSegment lstSegmentValue.Visible = True txtSegmentValue.Visible = False cmdSegmentAdd.Caption = "ADD" cmdSegmentEdit.Caption = "EDIT" cmdSegmentDelete.Caption = "DELETE" cmdSegmentEdit.Enabled = True SegFlag = "" 'CHECK THIS FreGroupLevel.Enabled = True FreScore.Enabled = True 'FreCharacteristicVariable.Enabled = True If (chkCSI.Value = True Or chkVDI.Value = True) Then FreCharacteristicVariable.Enabled = True Else FreCharacteristicVariable.Enabled = False End If       'FreScoreFmt.Enabled = False comboPSIfmt.Enabled = False cmdPSIfmt.Enabled = False FreBins.Enabled = False 'FreMetrics.Enabled = False FreBenchmark.Enabled = False FrePeriod.Enabled = False FreAlignmentParameters.Enabled = False 'FreCharacteristicVariable.Enabled = False cmdDescription.Enabled = False comboCSIfmt.Enabled = False cmdCSIfmt.Enabled = False txtSegmentValue.BackColor = &H80000005 comboPSIfmt.BackColor = &H80000005 txtBenchmarkKS.BackColor = &H80000005 txtBenchmarkTrueKS.BackColor = &H80000005 txtBenchmarkGini.BackColor = &H80000005 txtBenchmarkDivergence.BackColor = &H80000005 txtAverageGoodScore.BackColor = &H80000005 txtAverageBadScore.BackColor = &H80000005 txtImplementationDate.BackColor = &H80000005 txtPSIBenchmarkPeriod.BackColor = &H80000005 txtStrengthBenchmarkPeriod.BackColor = &H80000005 txtPSICurrentPeriod.BackColor = &H80000005 txtStrengthCurrentPeriod.BackColor = &H80000005 txtCSIBenchmarkPeriod.BackColor = &H80000005 txtAlignmentBenchmarkPeriod.BackColor = &H80000005 txtCSICurrentPeriod.BackColor = &H80000005 txtAlignmentCurrentPeriod.BackColor = &H80000005 txtAlignmentBaseScore.BackColor = &H80000005 txtPDO.BackColor = &H80000005 txtOddsAtBaseScore.BackColor = &H80000005 Call enableButtons Else If AddSegmentCheck Then txtSegmentValue.Text = "" Call defaultSegmentValueData cmdSegmentAdd.Enabled = False lstSegmentValue.Visible = False txtSegmentValue.Visible = True cmdSegmentEdit.Caption = "SAVE" cmdSegmentDelete.Caption = "CANCEL" SegFlag = "ADD"

FreGroupLevel.Enabled = False FreScore.Enabled = False FreScoreData.Enabled = False FreCharacteristicVariable.Enabled = False cmdDescription.Enabled = False comboCSIfmt.Enabled = False cmdCSIfmt.Enabled = False If optSameYes.Value = False Then FrePeriod.Enabled = True End If           If optAlignYes.Value = False Then FreAlignmentParameters.Enabled = True End If           FreBenchmark.Enabled = True 'FreScoreFmt.Enabled = True 'comboPSIfmt.Enabled = True 'cmdPSIfmt.Enabled = True comboPSIfmt.Enabled = False cmdPSIfmt.Enabled = False 'CHECK THIS 'FreBins.Enabled = True 'cmdUpdate.Enabled = True 'cmdCancelBins.Enabled = True 'Call chkCSIVDI txtSegmentValue.BackColor = &HC0FFFF 'comboPSIfmt.BackColor = &HC0FFFF txtBenchmarkKS.BackColor = &HC0FFFF txtBenchmarkTrueKS.BackColor = &HC0FFFF txtBenchmarkGini.BackColor = &HC0FFFF txtBenchmarkDivergence.BackColor = &HC0FFFF txtAverageGoodScore.BackColor = &HC0FFFF txtAverageBadScore.BackColor = &HC0FFFF If optSameYes.Value = False Then txtImplementationDate.BackColor = &HC0FFFF txtPSIBenchmarkPeriod.BackColor = &HC0FFFF txtStrengthBenchmarkPeriod.BackColor = &HC0FFFF txtPSICurrentPeriod.BackColor = &HC0FFFF txtStrengthCurrentPeriod.BackColor = &HC0FFFF txtCSIBenchmarkPeriod.BackColor = &HC0FFFF txtAlignmentBenchmarkPeriod.BackColor = &HC0FFFF txtCSICurrentPeriod.BackColor = &HC0FFFF txtAlignmentCurrentPeriod.BackColor = &HC0FFFF End If           If optAlignYes.Value = False Then txtAlignmentBaseScore.BackColor = &HC0FFFF txtPDO.BackColor = &HC0FFFF txtOddsAtBaseScore.BackColor = &HC0FFFF End If           Call disableButtons End If   End If End Sub

Private Sub cmdSegmentDelete_Click

Dim i, cntRow, cntLoop, startRow, endRow As Integer Dim cntRowC, cntLoopC, startRowC, endRowC As Integer

cmdSegmentAdd.Caption = "ADD" cmdSegmentEdit.Caption = "EDIT" cmdSegmentDelete.Caption = "DELETE" cmdSegmentAdd.Enabled = True cmdSegmentEdit.Enabled = True

If Not (SegFlag = "ADD" Or SegFlag = "EDIT") Then If lstSegmentValue.ListIndex = -1 Then MsgBox "Select item to edit", vbInformation + vbOKOnly, mConstants.sToolName ElseIf MsgBox("Delete selected segment and associated data?", vbQuestion + vbYesNo, mConstants.sToolName) = vbYes Then 'DELETE DATA FROM "SCORE SUMMARY" TAB SheetData.Visible = xlSheetVisible SheetData.Activate SheetData.Range("AJ" & CalculateCellRowSegment(lstGroupName.ListIndex + 1, lstScoreName.ListIndex + 1, lstSegmentValue.ListIndex + 1) & ":AT" & CalculateCellRowSegment(lstGroupName.ListIndex + 1, lstScoreName.ListIndex + 1, lstSegmentValue.ListIndex + 2) - 1).Select 'Selection.EntireRow.ClearContents 'SheetData.Range(Selection, Selection.End(xlToRight)).Select Selection.ClearContents For j = lstSegmentValue.ListIndex + 2 To lstSegmentValue.ListCount If optSameYes.Value = True Then 'Copy and paste the data SheetData.Range("AJ" & CalculateCellRowSegment(lstGroupName.ListIndex + 1, lstScoreName.ListIndex + 1, j) & ":AT" & CalculateCellRowSegment(lstGroupName.ListIndex + 1, lstScoreName.ListIndex + 1, j + 1) - 1).Select 'SheetData.Range(Selection, Selection.End(xlToRight)).Select Selection.Copy SheetData.Range("AJ" & CalculateCellRowSegment(lstGroupName.ListIndex + 1, lstScoreName.ListIndex + 1, j - 1) & ":AT" & CalculateCellRowSegment(lstGroupName.ListIndex + 1, lstScoreName.ListIndex + 1, j) - 1).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False Application.CutCopyMode = False SheetData.Range("AJ" & CalculateCellRowSegment(lstGroupName.ListIndex + 1, lstScoreName.ListIndex + 1, j - 1)).Select 'Delete the data SheetData.Range("AJ" & CalculateCellRowSegment(lstGroupName.ListIndex + 1, lstScoreName.ListIndex + 1, j) & ":AT" & CalculateCellRowSegment(lstGroupName.ListIndex + 1, lstScoreName.ListIndex + 1, j + 1) - 1).Select 'SheetData.Range(Selection, Selection.End(xlToRight)).Select Selection.ClearContents SheetData.Range("AJ" & CalculateCellRowSegment(lstGroupName.ListIndex + 1, lstScoreName.ListIndex + 1, j - 1)).Select Else 'Copy and paste the data SheetData.Range("AB" & CalculateCellRowSegment(lstGroupName.ListIndex + 1, lstScoreName.ListIndex + 1, j) & ":AT" & CalculateCellRowSegment(lstGroupName.ListIndex + 1, lstScoreName.ListIndex + 1, j + 1) - 1).Select 'SheetData.Range(Selection, Selection.End(xlToRight)).Select Selection.Copy SheetData.Range("AB" & CalculateCellRowSegment(lstGroupName.ListIndex + 1, lstScoreName.ListIndex + 1, j - 1) & ":AT" & CalculateCellRowSegment(lstGroupName.ListIndex + 1, lstScoreName.ListIndex + 1, j) - 1).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False Application.CutCopyMode = False SheetData.Range("AB" & CalculateCellRowSegment(lstGroupName.ListIndex + 1, lstScoreName.ListIndex + 1, j - 1)).Select 'Delete the data SheetData.Range("AB" & CalculateCellRowSegment(lstGroupName.ListIndex + 1, lstScoreName.ListIndex + 1, j) & ":AT" & CalculateCellRowSegment(lstGroupName.ListIndex + 1, lstScoreName.ListIndex + 1, j + 1) - 1).Select 'SheetData.Range(Selection, Selection.End(xlToRight)).Select Selection.ClearContents SheetData.Range("AB" & CalculateCellRowSegment(lstGroupName.ListIndex + 1, lstScoreName.ListIndex + 1, j - 1)).Select End If           Next 'DELETE DATA FROM "PSI DETAILS" TAB Call sortSegmentSheets Inp3PSI.Visible = xlSheetVisible Inp3PSI.Activate cntRow = WorksheetFunction.CountA(Inp3PSI.Range("A:A")) cntLoop = 0 For i = 2 To cntRow If Inp3PSI.Cells(i, 1).Value = comboScoreVariable.Value Then If Inp3PSI.Cells(i, 2).Value = comboSegmentVariable.Value Then If Inp3PSI.Cells(i, 3).Value = lstSegmentValue.List(SelSegIndx) Then If cntLoop = 0 Then startRow = i                           End If                            endRow = i                            cntLoop = cntLoop + 1 End If                   End If                End If            Next i            If (startRow > 0 And endRow > 0) Then Inp3PSI.Range("A" & startRow & ":L" & endRow).Select Selection.ClearContents Inp3PSI.Range("A" & endRow + 1 & ":L" & cntRow).Select Selection.Cut Inp3PSI.Range("A" & startRow).Select ActiveSheet.Paste Inp3PSI.Range("A" & startRow).Select End If           'DELETE DATA FROM "CHARACTERISTIC DETAILS" TAB Call sortCharacteristicSheets Inp4CSI.Visible = xlSheetVisible Inp4CSI.Activate cntRowC = WorksheetFunction.CountA(Inp4CSI.Range("A:A")) cntLoopC = 0 For i = 2 To cntRowC If Inp4CSI.Cells(i, 1).Value = comboScoreVariable.Value Then If Inp4CSI.Cells(i, 2).Value = comboSegmentVariable.Value Then If Inp4CSI.Cells(i, 3).Value = lstSegmentValue.List(SelSegIndx) Then If cntLoopC = 0 Then startRowC = i                           End If                            endRowC = i                            cntLoopC = cntLoopC + 1 End If                   End If                End If            Next i            If (startRowC > 0 And endRowC > 0) Then Inp4CSI.Range("A" & startRowC & ":Q" & endRowC).Select Selection.ClearContents Inp4CSI.Range("A" & endRowC + 1 & ":Q" & cntRowC).Select Selection.Cut Inp4CSI.Range("A" & startRowC).Select ActiveSheet.Paste Inp4CSI.Range("A" & startRowC).Select End If       'UNCOMMENT LATER SheetData.Visible = xlSheetHidden Inp3PSI.Visible = xlSheetHidden Inp4CSI.Visible = xlSheetHidden Inp0Button.Activate End If   End If Call RefreshSegmentList SegFlag = "" lstSegmentValue.Visible = True txtSegmentValue.Visible = False

FreGroupLevel.Enabled = True FreScore.Enabled = True

FreScoreData.Enabled = False FreBenchmark.Enabled = False 'FrePeriod.Enabled = False 'FreScoreFmt.Enabled = False comboPSIfmt.Enabled = False cmdPSIfmt.Enabled = False FreBins.Enabled = False 'FreCharacteristicVariable.Enabled = False 'cmdDescription.Enabled = False 'combocsifmt.Enabled = False 'cmdCSIfmt.Enabled = False

txtSegmentValue.BackColor = &H80000005 comboPSIfmt.BackColor = &H80000005 txtBenchmarkKS.BackColor = &H80000005 txtBenchmarkTrueKS.BackColor = &H80000005 txtBenchmarkGini.BackColor = &H80000005 txtBenchmarkDivergence.BackColor = &H80000005 txtAverageGoodScore.BackColor = &H80000005 txtAverageBadScore.BackColor = &H80000005 txtImplementationDate.BackColor = &H80000005 txtPSIBenchmarkPeriod.BackColor = &H80000005 txtStrengthBenchmarkPeriod.BackColor = &H80000005 txtPSICurrentPeriod.BackColor = &H80000005 txtStrengthCurrentPeriod.BackColor = &H80000005

txtCSIBenchmarkPeriod.BackColor = &H80000005 txtAlignmentBenchmarkPeriod.BackColor = &H80000005 txtCSICurrentPeriod.BackColor = &H80000005 txtAlignmentCurrentPeriod.BackColor = &H80000005 txtAlignmentBaseScore.BackColor = &H80000005 txtPDO.BackColor = &H80000005 txtOddsAtBaseScore.BackColor = &H80000005 Call enableButtons End Sub

Private Sub cmdSegmentEdit_Click If SegFlag = "ADD" Then Call AddOREditSegment lstSegmentValue.Visible = True txtSegmentValue.Visible = False cmdSegmentEdit.Caption = "EDIT" cmdSegmentDelete.Caption = "DELETE" cmdSegmentAdd.Enabled = True SegFlag = "" cmdSegmentAdd.Enabled = True 'CHECK THIS FreGroupLevel.Enabled = True FreScore.Enabled = True 'FreCharacteristicVariable.Enabled = True If (chkCSI.Value = True Or chkVDI.Value = True) Then FreCharacteristicVariable.Enabled = True Else FreCharacteristicVariable.Enabled = False End If   txtSegmentValue.BackColor = &H80000005 comboPSIfmt.BackColor = &H80000005 txtBenchmarkKS.BackColor = &H80000005 txtBenchmarkTrueKS.BackColor = &H80000005 txtBenchmarkGini.BackColor = &H80000005 txtBenchmarkDivergence.BackColor = &H80000005 txtAverageGoodScore.BackColor = &H80000005 txtAverageBadScore.BackColor = &H80000005 txtImplementationDate.BackColor = &H80000005 txtPSIBenchmarkPeriod.BackColor = &H80000005 txtStrengthBenchmarkPeriod.BackColor = &H80000005 txtPSICurrentPeriod.BackColor = &H80000005 txtStrengthCurrentPeriod.BackColor = &H80000005 txtCSIBenchmarkPeriod.BackColor = &H80000005 txtAlignmentBenchmarkPeriod.BackColor = &H80000005 txtCSICurrentPeriod.BackColor = &H80000005 txtAlignmentCurrentPeriod.BackColor = &H80000005 txtAlignmentBaseScore.BackColor = &H80000005 txtPDO.BackColor = &H80000005 txtOddsAtBaseScore.BackColor = &H80000005

Call enableButtons Else If lstSegmentValue.ListIndex = -1 Then MsgBox "Select item to edit", vbInformation + vbOKOnly, mConstants.sToolName Exit Sub End If   Call EditCurrentItemSegment cmdSegmentEdit.Enabled = False SegFlag = "EDIT" lstSegmentValue.Visible = False txtSegmentValue.Visible = True cmdSegmentAdd.Caption = "SAVE" cmdSegmentDelete.Caption = "CANCEL" FreGroupLevel.Enabled = False FreScore.Enabled = False FreScoreData.Enabled = False FreCharacteristicVariable.Enabled = False cmdDescription.Enabled = False comboCSIfmt.Enabled = False cmdCSIfmt.Enabled = False FreBenchmark.Enabled = True If optSameYes.Value = False Then FrePeriod.Enabled = True End If   If optAlignYes.Value = False Then FreAlignmentParameters.Enabled = True End If   'FreScoreFmt.Enabled = True comboPSIfmt.Enabled = True cmdPSIfmt.Enabled = True 'CHECK THIS If comboPSIfmt.Value <> "" Then FreBins.Enabled = True cmdUpdate.Enabled = True cmdCancelBins.Enabled = True End If   'MIGHT NOT BE REQUIRED If lstCharacteristicName.ListIndex <> -1 Then cmdDescription.Enabled = True comboCSIfmt.Enabled = True cmdCSIfmt.Enabled = True End If

'Call chkCSIVDI txtSegmentValue.BackColor = &HFFFFC0 comboPSIfmt.BackColor = &HFFFFC0 txtBenchmarkKS.BackColor = &HFFFFC0 txtBenchmarkTrueKS.BackColor = &HFFFFC0 txtBenchmarkGini.BackColor = &HFFFFC0 txtBenchmarkDivergence.BackColor = &HFFFFC0 txtAverageGoodScore.BackColor = &HFFFFC0 txtAverageBadScore.BackColor = &HFFFFC0 If optSameYes.Value = False Then txtImplementationDate.BackColor = &HFFFFC0 txtPSIBenchmarkPeriod.BackColor = &HFFFFC0 txtStrengthBenchmarkPeriod.BackColor = &HFFFFC0 txtPSICurrentPeriod.BackColor = &HFFFFC0 txtStrengthCurrentPeriod.BackColor = &HFFFFC0 txtCSIBenchmarkPeriod.BackColor = &HFFFFC0 txtAlignmentBenchmarkPeriod.BackColor = &HFFFFC0 txtCSICurrentPeriod.BackColor = &HFFFFC0 txtAlignmentCurrentPeriod.BackColor = &HFFFFC0 End If   If optAlignYes.Value = False Then txtAlignmentBaseScore.BackColor = &HFFFFC0 txtPDO.BackColor = &HFFFFC0 txtOddsAtBaseScore.BackColor = &HFFFFC0 End If   Call disableButtons End If End Sub

Sub EditCurrentItemSegment 'txtSegmentValue.Text = lstSegmentValue.Text txtSegmentValue.Text = lstSegmentValue.List(SelSegIndx) End Sub

Private Sub lstSegmentValue_Click Call lstSegmentValue_Change End Sub

Private Sub lstSegmentValue_Change Dim k As Integer

fmtFlag = "PSI"

For k = 0 To lstSegmentValue.ListCount - 1 If lstSegmentValue.Selected(k) = True Then SelSegIndx = k       txtSegmentValue.Text = lstSegmentValue.Selected(k) 'txtSegmentValue.Text = lstSegmentValue.List(k) End If Next

'TO FIX ERROR DURING SEGMENT VALUE SELECTION CHANGE lstCharacteristicName.ListIndex = -1

Call RefreshSegmentListData Call RefreshCharacteristicList

FreBins.Caption = "PSI/CSI Bins" FreBins.Enabled = False cmdUpdate.Enabled = False cmdCancelBins.Enabled = False

'NEED TO FIGURE OUT WHY CALLING THE BELOW SUB THROWS INVALID PROPERTY ERROR If lstSegmentValue.ListIndex >= 0 Then Call RefreshBinsPSI Call RefreshBinsCSI End If

End Sub

Function AddSegmentCheck As Boolean AddSegmentCheck = True If lstSegmentValue.ListCount = MaxSegment Then MsgBox "Cannot add more than " & MaxSegment & " segments", vbInformation + vbOKOnly, mConstants.sToolName AddSegmentCheck = False Exit Function End If End Function

Sub AddOREditSegment Dim StartRange As Integer Dim EndRange As Integer Dim ListID As Integer ListID = -1

If SegFlag = "ADD" Then ListID = lstSegmentValue.ListCount ElseIf SegFlag = "EDIT" Then ListID = lstSegmentValue.ListIndex End If   If ListID <> -1 Then StartRange = CalculateCellRowSegment(SelGrpIndx + 1, SelScrIndx + 1, (ListID + 1)) EndRange = CalculateCellRowSegment(SelGrpIndx + 1, SelScrIndx + 1, MaxSegment) End If   If Len(Trim(txtSegmentValue.Text)) < 1 Then MsgBox "Required fields missing", vbCritical + vbOKOnly, mConstants.sToolName Exit Sub End If

Call addSegmentValue(StartRange) Call RefreshSegmentList Call RefreshBinsPSI 'Call RefreshBinsCSI End Sub

Sub addSegmentValue(ByVal StartRange As Integer) SheetData.Visible = xlSheetVisible If optAlignYes.Value = False Then SheetData.Cells(StartRange, 24).Value = txtAlignmentBaseScore.Value SheetData.Cells(StartRange, 25).Value = txtPDO.Value SheetData.Cells(StartRange, 26).Value = txtOddsAtBaseScore.Value End If   If optSameYes.Value = False Then SheetData.Cells(StartRange, 27).Value = "'" & UCase(txtImplementationDate.Text) SheetData.Cells(StartRange, 28).Value = "'" & UCase(txtPSIBenchmarkPeriod.Text) SheetData.Cells(StartRange, 29).Value = "'" & UCase(txtCSIBenchmarkPeriod.Text) SheetData.Cells(StartRange, 30).Value = "'" & UCase(txtStrengthBenchmarkPeriod.Text) SheetData.Cells(StartRange, 31).Value = "'" & UCase(txtAlignmentBenchmarkPeriod.Text) SheetData.Cells(StartRange, 32).Value = "'" & UCase(txtPSICurrentPeriod.Text) SheetData.Cells(StartRange, 33).Value = "'" & UCase(txtCSICurrentPeriod.Text) SheetData.Cells(StartRange, 34).Value = "'" & UCase(txtStrengthCurrentPeriod.Text) SheetData.Cells(StartRange, 35).Value = "'" & UCase(txtAlignmentCurrentPeriod.Text) End If

SheetData.Cells(StartRange, 36).Value = UCase(txtSegmentValue.Text) SheetData.Cells(StartRange, 37).Value = txtBenchmarkKS.Text SheetData.Cells(StartRange, 38).Value = txtBenchmarkTrueKS.Text SheetData.Cells(StartRange, 39).Value = txtBenchmarkGini.Text SheetData.Cells(StartRange, 40).Value = txtBenchmarkDivergence.Text SheetData.Cells(StartRange, 41).Value = txtBadRate.Text SheetData.Cells(StartRange, 42).Value = txtAverageGoodScore.Text SheetData.Cells(StartRange, 43).Value = txtAverageBadScore.Text SheetData.Visible = xlSheetHidden 'ADD CHARACTERISTIC VARIABLES 'StartRangeC = CalculateCellRowCharacteristic(SelGrpIndx + 1, SelScrIndx + 1, SelSegIndx + 1, 1) 'EndRangeC = CalculateCellRowCharacteristic(SelGrpIndx + 1, SelScrIndx + 1, SelSegIndx + 2, 1) - 1

'Call addCharacteristicVaribles(StartRangeC, EndRangeC) 'Call deleteCharacteristicVariables 'Call RefreshCharacteristicList

End Sub

'ACCEPTABLE CHARACTERS FOR SCORE DATA TEXTBOXES Private Sub txtScoreLowerBound_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger) Select Case KeyAscii Case 43 To 46, 48 To 57  'acceptable characters Case 8  'backspace key strval = Left(txtScoreLowerBound.Text, Len(txtScoreLowerBound.Text) - 1) Case Else  'nothing happens if the character is unacceptable KeyAscii = 0 End Select End Sub

Private Sub txtScoreUpperBound_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger) Select Case KeyAscii Case 43 To 46, 48 To 57  'acceptable characters Case 8  'backspace key strval = Left(txtScoreUpperBound.Text, Len(txtScoreUpperBound.Text) - 1) Case Else  'nothing happens if the character is unacceptable KeyAscii = 0 End Select End Sub

Private Sub txtAlignmentBaseScore_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger) Select Case KeyAscii Case 43 To 46, 48 To 57  'acceptable characters Case 8  'backspace key strval = Left(txtAlignmentBaseScore.Text, Len(txtAlignmentBaseScore.Text) - 1) Case Else  'nothing happens if the character is unacceptable KeyAscii = 0 End Select End Sub

Private Sub txtPDO_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger) Select Case KeyAscii Case 43 To 46, 48 To 57  'acceptable characters Case 8  'backspace key strval = Left(txtPDO.Text, Len(txtPDO.Text) - 1) Case Else  'nothing happens if the character is unacceptable KeyAscii = 0 End Select End Sub

Private Sub txtOddsAtBaseScore_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger) Select Case KeyAscii Case 43 To 46, 48 To 57  'acceptable characters Case 8  'backspace key strval = Left(txtOddsAtBaseScore.Text, Len(txtOddsAtBaseScore.Text) - 1) Case Else  'nothing happens if the character is unacceptable KeyAscii = 0 End Select End Sub

Private Sub txtBadRate_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger) Select Case KeyAscii Case 43 To 46, 48 To 57  'acceptable characters Case 8  'backspace key strval = Left(txtBadRate.Text, Len(txtBadRate.Text) - 1) Case Else  'nothing happens if the character is unacceptable KeyAscii = 0 End Select End Sub

'ACCEPTABLE CHARACTERS FOR BENCHMARK TEXTBOXES Private Sub txtBenchmarkKS_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger) Select Case KeyAscii Case 43 To 46, 48 To 57  'acceptable characters Case 8  'backspace key strval = Left(txtBenchmarkKS.Text, Len(txtBenchmarkKS.Text) - 1) Case Else  'nothing happens if the character is unacceptable KeyAscii = 0 End Select End Sub

Private Sub txtBenchmarkTrueKS_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger) Select Case KeyAscii Case 43 To 46, 48 To 57  'acceptable characters Case 8  'backspace key strval = Left(txtBenchmarkTrueKS.Text, Len(txtBenchmarkTrueKS.Text) - 1) Case Else  'nothing happens if the character is unacceptable KeyAscii = 0 End Select End Sub

Private Sub txtBenchmarkGini_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger) Select Case KeyAscii Case 43 To 46, 48 To 57  'acceptable characters Case 8  'backspace key strval = Left(txtBenchmarkGini.Text, Len(txtBenchmarkGini.Text) - 1) Case Else  'nothing happens if the character is unacceptable KeyAscii = 0 End Select End Sub

Private Sub txtBenchmarkDivergence_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger) Select Case KeyAscii Case 43 To 46, 48 To 57  'acceptable characters Case 8  'backspace key strval = Left(txtBenchmarkDivergence.Text, Len(txtBenchmarkDivergence.Text) - 1) Case Else  'nothing happens if the character is unacceptable KeyAscii = 0 End Select End Sub

Private Sub txtAverageGoodScore_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger) Select Case KeyAscii Case 43 To 46, 48 To 57  'acceptable characters Case 8  'backspace key strval = Left(txtAverageGoodScore.Text, Len(txtAverageGoodScore.Text) - 1) Case Else  'nothing happens if the character is unacceptable KeyAscii = 0 End Select End Sub

Private Sub txtAverageBadScore_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger) Select Case KeyAscii Case 43 To 46, 48 To 57  'acceptable characters Case 8  'backspace key strval = Left(txtAverageBadScore.Text, Len(txtAverageBadScore.Text) - 1) Case Else  'nothing happens if the character is unacceptable KeyAscii = 0 End Select End Sub

'POP UP CHARACTERISTIC VARIABLE LIST Private Sub cmdCharSelect_Click Dim StartRange, EndRange As Integer

'var.Activate 'cntVar = WorksheetFunction.CountA(var.Range("A:A")) - 1

'PREVIOUS CODE TO POPULATE CHARACTERISTIC LIST 'For i = 1 To cntVar '   frmCharVarList.lstCharSelect.AddItem (var.Cells(i + 1, 1).Value) '   frmCharVarList.lstCharSelect.List(i - 1, 1) = var.Cells(i + 1, 2).Value '   frmCharVarList.lstCharSelect.List(i - 1, 2) = var.Cells(i + 1, 3).Value 'Next i

Inp0Button.Range("B10").Value = 0 frmGroupView.Hide

'Inp0Button.Range("B2").Value = 1 frmCharVarList.Show vbModal

'PREVIOUS CODE TO UPDATE CHARACTERISTIC VARIABLES TO SHEETDATA

'StartRange = CalculateCellRowCharacteristic(SelGrpIndx + 1, SelScrIndx + 1, SelSegIndx + 1, 1) 'EndRange = CalculateCellRowCharacteristic(SelGrpIndx + 1, SelScrIndx + 1, SelSegIndx + 2, 1) - 1

'Call addCharacteristicVaribles(StartRange, EndRange) 'Call deleteCharacteristicVariables 'Call RefreshCharacteristicList

'Inp0Button.Range("B10").Value = 1

End Sub

'EDIT CHARACTERISTIC DESCRIPTION/TYPE Private Sub cmdDescription_Click

Dim oldDescription, newDescription, oldType, newType As String Dim i As Integer

oldDescription = UCase(lstCharacteristicName.List(SelChrIndx, 1)) oldType = UCase(lstCharacteristicName.List(SelChrIndx, 2))

Load frmDescriptionChange frmDescriptionChange.txtDescription.Text = oldDescription frmDescriptionChange.txtType.Text = oldType

frmDescriptionChange.Show

newDescription = UCase(frmDescriptionChange.txtDescription.Text) newType = UCase(frmDescriptionChange.txtType.Text)

lstCharacteristicName.List(SelChrIndx, 1) = newDescription lstCharacteristicName.List(SelChrIndx, 2) = newType

'OVERWRITE IN "SCORE SUMMARY" TAB SheetData.Visible = xlSheetVisible SheetData.Cells(CalculateCellRowCharacteristic(SelGrpIndx + 1, SelScrIndx + 1, SelSegIndx + 1, SelChrIndx), 45).Value = newDescription SheetData.Cells(CalculateCellRowCharacteristic(SelGrpIndx + 1, SelScrIndx + 1, SelSegIndx + 1, SelChrIndx), 46).Value = newType

'OVERWRITE IN "VARIABLES" TAB cntRow = WorksheetFunction.CountA(var.Range("A:A")) For i = 2 To cntRow If UCase(var.Cells(i, 1).Value) = UCase(lstCharacteristicName.List(SelChrIndx)) Then var.Cells(i, 2).Value = newDescription var.Cells(i, 3).Value = newType Exit For End If Next i

SheetData.Visible = xlSheetHidden Unload frmDescriptionChange End Sub

'ADD CHARACTERISTIC VARIABLES TO "SCORE SUMMARY" TAB Public Sub addCharacteristicVaribles(ByVal StartRange As Integer, ByVal EndRange As Integer) Dim i As Integer

SheetData.Visible = xlSheetVisible SheetData.Activate SheetData.Range(Cells(StartRange, 44), Cells(EndRange, 46)).ClearContents For i = 0 To frmGroupView.lstCharacteristicName.ListCount - 1 SheetData.Cells(StartRange + i, 44).Value = UCase(lstCharacteristicName.List(i)) SheetData.Cells(StartRange + i, 45).Value = UCase(lstCharacteristicName.List(i, 1)) SheetData.Cells(StartRange + i, 46).Value = UCase(lstCharacteristicName.List(i, 2)) Next i SheetData.Visible = xlSheetHidden End Sub

'DELETE UNSELECTED CHARACTERISTIC VARIABLES' BINS FROM "CHARACTERISTIC DETAILS" TAB Public Sub deleteCharacteristicVariables Dim i, k, cntRowC, cntLoopC, delRow As Integer

Call sortCharacteristicSheets Inp4CSI.Visible = xlSheetVisible Inp4CSI.Activate

cntRowC = WorksheetFunction.CountA(Inp4CSI.Range("A:A")) cntLoopC = 0

For i = 2 To cntRowC If Inp4CSI.Cells(i, 4).Value = "" Then Exit For Else delRow = 0 If UCase(Inp4CSI.Cells(i, 1).Value) = UCase(comboScoreVariable.Value) Then If UCase(Inp4CSI.Cells(i, 2).Value) = (comboSegmentVariable.Value) Then If UCase(Inp4CSI.Cells(i, 3).Value) = UCase(lstSegmentValue.List(SelSegIndx)) Then For k = 0 To lstCharacteristicName.ListCount - 1 If UCase(Inp4CSI.Cells(i, 4).Value) = UCase(lstCharacteristicName.List(k)) Then delRow = delRow + 1 End If                   Next k                Else Inp4CSI.Visible = xlSheetHidden Exit Sub End If           Else Inp4CSI.Visible = xlSheetHidden Exit Sub End If       Else Inp4CSI.Visible = xlSheetHidden Exit Sub End If   End If    If delRow = 0 Then Rows(i).Delete i = i - 1 End If Next i

'UNCOMMENT LATER Inp4CSI.Visible = xlSheetHidden

End Sub

'PSI FORMAT COMMANDBUTTON TASKS Private Sub cmdPSIfmt_Click Dim j, k, l, m, cntRow, cntBin, cntBinPSI, mchRow As Integer

Inp3PSI.Visible = xlSheetVisible fmt.Visible = xlSheetVisible

FreBins.Enabled = True cmdUpdate.Enabled = True cmdCancelBins.Enabled = True

FreGroupLevel.Enabled = False FreScore.Enabled = False FreMetrics.Enabled = False FreBenchmark.Enabled = False FrePeriod.Enabled = False FreAlignmentParameters.Enabled = False

lstSegmentValue.Enabled = False cmdSegmentAdd.Enabled = False cmdSegmentDelete.Enabled = False

cntRow = WorksheetFunction.CountA(Inp3PSI.Range("D:D"))

If comboPSIfmt.Value <> "" Then cntBin = WorksheetFunction.CountIf(fmt.Range("A:A"), comboPSIfmt.Value) cntBinPSI = WorksheetFunction.CountIf(Inp3PSI.Range("D:D"), comboPSIfmt.Value) '   If cntBinPSI <= 0 Then '       mchRow = WorksheetFunction.Match(comboPSIfmt.Value, fmt.Range("A:A"), 0) '   End If    For j = 2 To 51 For k = 1 To 10 sheetBins.Cells(j, k).Value = "" Next k   Next j    If cntBinPSI > 0 Then For l = 2 To cntRow If UCase(Inp3PSI.Cells(l, 1).Value) = UCase(comboScoreVariable.Value) Then If UCase(Inp3PSI.Cells(l, 2).Value) = UCase(comboSegmentVariable.Value) Then If UCase(Inp3PSI.Cells(l, 3).Value) = UCase(lstSegmentValue.List(SelSegIndx)) Then comboPSIfmt.Value = UCase(Inp3PSI.Cells(l, 4).Value) For m = 1 To cntBinPSI sheetBins.Cells(m + 1, 1).Value = Inp3PSI.Cells(l + m - 1, 4).Value sheetBins.Cells(m + 1, 2).Value = Inp3PSI.Cells(l + m - 1, 5).Value sheetBins.Cells(m + 1, 3).Value = Inp3PSI.Cells(l + m - 1, 6).Value sheetBins.Cells(m + 1, 4).Value = Inp3PSI.Cells(l + m - 1, 7).Value sheetBins.Cells(m + 1, 5).Value = Inp3PSI.Cells(l + m - 1, 8).Value sheetBins.Cells(m + 1, 6).Value = Inp3PSI.Cells(l + m - 1, 9).Value sheetBins.Cells(m + 1, 7).Value = Inp3PSI.Cells(l + m - 1, 10).Value sheetBins.Cells(m + 1, 8).Value = Inp3PSI.Cells(l + m - 1, 11).Value sheetBins.Cells(m + 1, 9).Value = Inp3PSI.Cells(l + m - 1, 12).Value sheetBins.Cells(m + 31, 1).Value = Inp3PSI.Cells(l + m - 1, 4).Value sheetBins.Cells(m + 31, 2).Value = Inp3PSI.Cells(l + m - 1, 5).Value sheetBins.Cells(m + 31, 3).Value = Inp3PSI.Cells(l + m - 1, 6).Value sheetBins.Cells(m + 31, 4).Value = Inp3PSI.Cells(l + m - 1, 7).Value sheetBins.Cells(m + 31, 5).Value = Inp3PSI.Cells(l + m - 1, 8).Value sheetBins.Cells(m + 31, 6).Value = Inp3PSI.Cells(l + m - 1, 9).Value sheetBins.Cells(m + 31, 7).Value = Inp3PSI.Cells(l + m - 1, 10).Value sheetBins.Cells(m + 31, 8).Value = Inp3PSI.Cells(l + m - 1, 11).Value sheetBins.Cells(m + 31, 9).Value = Inp3PSI.Cells(l + m - 1, 12).Value Next m                       Inp3PSI.Visible = xlSheetHidden fmt.Visible = xlSheetHidden Exit Sub End If               End If            End If        Next l    End If    mchRow = WorksheetFunction.Match(comboPSIfmt.Value, fmt.Range("A:A"), 0) If mchRow <> Empty Then For i = 1 To cntBin sheetBins.Cells(i + 1, 1).Value = fmt.Cells(mchRow + i - 1, 1).Value sheetBins.Cells(i + 1, 2).Value = fmt.Cells(mchRow + i - 1, 2).Value sheetBins.Cells(i + 1, 3).Value = fmt.Cells(mchRow + i - 1, 3).Value sheetBins.Cells(i + 1, 4).Value = fmt.Cells(mchRow + i - 1, 4).Value sheetBins.Cells(i + 1, 5).Value = fmt.Cells(mchRow + i - 1, 5).Value sheetBins.Cells(i + 1, 6).Value = fmt.Cells(mchRow + i - 1, 6).Value sheetBins.Cells(i + 1, 7).Value = fmt.Cells(mchRow + i - 1, 7).Value sheetBins.Cells(i + 31, 1).Value = fmt.Cells(mchRow + i - 1, 1).Value sheetBins.Cells(i + 31, 2).Value = fmt.Cells(mchRow + i - 1, 2).Value sheetBins.Cells(i + 31, 3).Value = fmt.Cells(mchRow + i - 1, 3).Value sheetBins.Cells(i + 31, 4).Value = fmt.Cells(mchRow + i - 1, 4).Value sheetBins.Cells(i + 31, 5).Value = fmt.Cells(mchRow + i - 1, 5).Value sheetBins.Cells(i + 31, 6).Value = fmt.Cells(mchRow + i - 1, 6).Value sheetBins.Cells(i + 31, 7).Value = fmt.Cells(mchRow + i - 1, 7).Value Next i   End If Else For l = 2 To cntRow If UCase(Inp3PSI.Cells(l, 1).Value) = UCase(comboScoreVariable.Value) Then If UCase(Inp3PSI.Cells(l, 2).Value) = UCase(comboSegmentVariable.Value) Then If UCase(Inp3PSI.Cells(l, 3).Value) = UCase(lstSegmentValue.List(SelSegIndx)) Then comboPSIfmt.Value = UCase(Inp3PSI.Cells(l, 4).Value) cntBin = WorksheetFunction.CountIf(fmt.Range("A:A"), comboPSIfmt.Value) For m = 1 To cntBin sheetBins.Cells(m + 1, 1).Value = Inp3PSI.Cells(l + m - 1, 4).Value sheetBins.Cells(m + 1, 2).Value = Inp3PSI.Cells(l + m - 1, 5).Value sheetBins.Cells(m + 1, 3).Value = Inp3PSI.Cells(l + m - 1, 6).Value sheetBins.Cells(m + 1, 4).Value = Inp3PSI.Cells(l + m - 1, 7).Value sheetBins.Cells(m + 1, 5).Value = Inp3PSI.Cells(l + m - 1, 8).Value sheetBins.Cells(m + 1, 6).Value = Inp3PSI.Cells(l + m - 1, 9).Value sheetBins.Cells(m + 1, 7).Value = Inp3PSI.Cells(l + m - 1, 10).Value sheetBins.Cells(m + 1, 8).Value = Inp3PSI.Cells(l + m - 1, 11).Value sheetBins.Cells(m + 1, 9).Value = Inp3PSI.Cells(l + m - 1, 12).Value sheetBins.Cells(m + 31, 1).Value = Inp3PSI.Cells(l + m - 1, 4).Value sheetBins.Cells(m + 31, 2).Value = Inp3PSI.Cells(l + m - 1, 5).Value sheetBins.Cells(m + 31, 3).Value = Inp3PSI.Cells(l + m - 1, 6).Value sheetBins.Cells(m + 31, 4).Value = Inp3PSI.Cells(l + m - 1, 7).Value sheetBins.Cells(m + 31, 5).Value = Inp3PSI.Cells(l + m - 1, 8).Value sheetBins.Cells(m + 31, 6).Value = Inp3PSI.Cells(l + m - 1, 9).Value sheetBins.Cells(m + 31, 7).Value = Inp3PSI.Cells(l + m - 1, 10).Value sheetBins.Cells(m + 31, 8).Value = Inp3PSI.Cells(l + m - 1, 11).Value sheetBins.Cells(m + 31, 9).Value = Inp3PSI.Cells(l + m - 1, 12).Value Next m                   Inp3PSI.Visible = xlSheetHidden fmt.Visible = xlSheetHidden Exit Sub End If           End If        End If    Next l

For j = 2 To 51 For k = 1 To 10 sheetBins.Cells(j, k).Value = "" Next k Next j MsgBox "Please select a format or edit in the sheet!", vbInformation + vbOKOnly, mConstants.sToolName

End If

Inp3PSI.Visible = xlSheetHidden fmt.Visible = xlSheetHidden

Call disableButtons End Sub

'CSI FORMAT COMMANDBUTTON TASKS Private Sub cmdCSIfmt_Click Dim j, k, l, m, cntRow, cntBin, cntBinCSI, mchRow As Integer

Inp4CSI.Visible = xlSheetVisible fmt.Visible = xlSheetVisible

FreBins.Enabled = True cmdUpdate.Enabled = True cmdCancelBins.Enabled = True

FreGroupLevel.Enabled = False FreScore.Enabled = False FreSegment.Enabled = False FreCharacteristicVariable.Enabled = False

FreScoreData.Enabled = False FreMetrics.Enabled = False FreBenchmark.Enabled = False FrePeriod.Enabled = False FreAlignmentParameters.Enabled = False

cntRow = WorksheetFunction.CountA(Inp3PSI.Range("D:D"))

If comboCSIfmt.Value <> "" Then cntBin = WorksheetFunction.CountIf(fmt.Range("A:A"), comboCSIfmt.Value) cntBinCSI = WorksheetFunction.CountIf(Inp4CSI.Range("D:D"), comboCSIfmt.Value) '   If cntBinCSI <= 0 Then '       mchRow = WorksheetFunction.Match(comboCSIfmt.Value, fmt.Range("A:A"), 0) '   End If    For j = 2 To 51 For k = 1 To 10 sheetBins.Cells(j, k).Value = "" Next k   Next j    If cntBinCSI > 0 Then For l = 2 To cntRow If UCase(Inp4CSI.Cells(l, 1).Value) = UCase(comboScoreVariable.Value) Then If UCase(Inp4CSI.Cells(l, 2).Value) = UCase(comboSegmentVariable.Value) Then If UCase(Inp4CSI.Cells(l, 3).Value) = UCase(lstSegmentValue.List(SelSegIndx)) Then If UCase(Inp4CSI.Cells(l, 4).Value) = UCase(lstCharacteristicName.List(SelChrIndx)) Then comboCSIfmt.Value = UCase(Inp4CSI.Cells(l, 5).Value) For m = 1 To cntBinCSI sheetBins.Cells(m + 1, 1).Value = Inp4CSI.Cells(l + m - 1, 5).Value sheetBins.Cells(m + 1, 2).Value = Inp4CSI.Cells(l + m - 1, 6).Value sheetBins.Cells(m + 1, 3).Value = Inp4CSI.Cells(l + m - 1, 7).Value sheetBins.Cells(m + 1, 4).Value = Inp4CSI.Cells(l + m - 1, 8).Value sheetBins.Cells(m + 1, 5).Value = Inp4CSI.Cells(l + m - 1, 9).Value sheetBins.Cells(m + 1, 6).Value = Inp4CSI.Cells(l + m - 1, 10).Value sheetBins.Cells(m + 1, 7).Value = Inp4CSI.Cells(l + m - 1, 11).Value sheetBins.Cells(m + 1, 8).Value = Inp4CSI.Cells(l + m - 1, 12).Value sheetBins.Cells(m + 1, 9).Value = Inp4CSI.Cells(l + m - 1, 13).Value sheetBins.Cells(m + 1, 10).Value = Inp4CSI.Cells(l + m - 1, 14).Value sheetBins.Cells(m + 31, 1).Value = Inp4CSI.Cells(l + m - 1, 5).Value sheetBins.Cells(m + 31, 2).Value = Inp4CSI.Cells(l + m - 1, 6).Value sheetBins.Cells(m + 31, 3).Value = Inp4CSI.Cells(l + m - 1, 7).Value sheetBins.Cells(m + 31, 4).Value = Inp4CSI.Cells(l + m - 1, 8).Value sheetBins.Cells(m + 31, 5).Value = Inp4CSI.Cells(l + m - 1, 9).Value sheetBins.Cells(m + 31, 6).Value = Inp4CSI.Cells(l + m - 1, 10).Value sheetBins.Cells(m + 31, 7).Value = Inp4CSI.Cells(l + m - 1, 11).Value sheetBins.Cells(m + 31, 8).Value = Inp4CSI.Cells(l + m - 1, 12).Value sheetBins.Cells(m + 31, 9).Value = Inp4CSI.Cells(l + m - 1, 13).Value sheetBins.Cells(m + 31, 9).Value = Inp4CSI.Cells(l + m - 1, 14).Value Next m                           Inp4CSI.Visible = xlSheetHidden fmt.Visible = xlSheetHidden Exit Sub End If                   End If                End If            End If        Next l    End If    mchRow = WorksheetFunction.Match(comboCSIfmt.Value, fmt.Range("A:A"), 0) If mchRow <> Empty Then For i = 1 To cntBin sheetBins.Cells(i + 1, 1).Value = fmt.Cells(mchRow + i - 1, 1).Value sheetBins.Cells(i + 1, 2).Value = fmt.Cells(mchRow + i - 1, 2).Value sheetBins.Cells(i + 1, 3).Value = fmt.Cells(mchRow + i - 1, 3).Value sheetBins.Cells(i + 1, 4).Value = fmt.Cells(mchRow + i - 1, 4).Value sheetBins.Cells(i + 1, 5).Value = fmt.Cells(mchRow + i - 1, 5).Value sheetBins.Cells(i + 1, 6).Value = fmt.Cells(mchRow + i - 1, 6).Value sheetBins.Cells(i + 1, 7).Value = fmt.Cells(mchRow + i - 1, 7).Value sheetBins.Cells(i + 31, 1).Value = fmt.Cells(mchRow + i - 1, 1).Value sheetBins.Cells(i + 31, 2).Value = fmt.Cells(mchRow + i - 1, 2).Value sheetBins.Cells(i + 31, 3).Value = fmt.Cells(mchRow + i - 1, 3).Value sheetBins.Cells(i + 31, 4).Value = fmt.Cells(mchRow + i - 1, 4).Value sheetBins.Cells(i + 31, 5).Value = fmt.Cells(mchRow + i - 1, 5).Value sheetBins.Cells(i + 31, 6).Value = fmt.Cells(mchRow + i - 1, 6).Value sheetBins.Cells(i + 31, 7).Value = fmt.Cells(mchRow + i - 1, 7).Value Next i   End If Else For l = 2 To cntRow If UCase(Inp4CSI.Cells(l, 1).Value) = UCase(comboScoreVariable.Value) Then If UCase(Inp4CSI.Cells(l, 2).Value) = UCase(comboSegmentVariable.Value) Then If UCase(Inp4CSI.Cells(l, 3).Value) = UCase(lstSegmentValue.List(SelSegIndx)) Then If UCase(Inp4CSI.Cells(l, 4).Value) = UCase(lstCharacteristicName.List(SelChrIndx)) Then comboCSIfmt.Value = UCase(Inp4CSI.Cells(l, 4).Value) cntBin = WorksheetFunction.CountIf(fmt.Range("A:A"), comboCSIfmt.Value) For m = 1 To cntBin sheetBins.Cells(m + 1, 1).Value = Inp4CSI.Cells(l + m - 1, 5).Value sheetBins.Cells(m + 1, 2).Value = Inp4CSI.Cells(l + m - 1, 6).Value sheetBins.Cells(m + 1, 3).Value = Inp4CSI.Cells(l + m - 1, 7).Value sheetBins.Cells(m + 1, 4).Value = Inp4CSI.Cells(l + m - 1, 8).Value sheetBins.Cells(m + 1, 5).Value = Inp4CSI.Cells(l + m - 1, 9).Value sheetBins.Cells(m + 1, 6).Value = Inp4CSI.Cells(l + m - 1, 10).Value sheetBins.Cells(m + 1, 7).Value = Inp4CSI.Cells(l + m - 1, 11).Value sheetBins.Cells(m + 1, 8).Value = Inp4CSI.Cells(l + m - 1, 12).Value sheetBins.Cells(m + 1, 9).Value = Inp4CSI.Cells(l + m - 1, 13).Value sheetBins.Cells(m + 1, 10).Value = Inp4CSI.Cells(l + m - 1, 14).Value sheetBins.Cells(m + 31, 1).Value = Inp4CSI.Cells(l + m - 1, 5).Value sheetBins.Cells(m + 31, 2).Value = Inp4CSI.Cells(l + m - 1, 6).Value sheetBins.Cells(m + 31, 3).Value = Inp4CSI.Cells(l + m - 1, 7).Value sheetBins.Cells(m + 31, 4).Value = Inp4CSI.Cells(l + m - 1, 8).Value sheetBins.Cells(m + 31, 5).Value = Inp4CSI.Cells(l + m - 1, 9).Value sheetBins.Cells(m + 31, 6).Value = Inp4CSI.Cells(l + m - 1, 10).Value sheetBins.Cells(m + 31, 7).Value = Inp4CSI.Cells(l + m - 1, 11).Value sheetBins.Cells(m + 31, 8).Value = Inp4CSI.Cells(l + m - 1, 12).Value sheetBins.Cells(m + 31, 9).Value = Inp4CSI.Cells(l + m - 1, 13).Value sheetBins.Cells(m + 31, 9).Value = Inp4CSI.Cells(l + m - 1, 14).Value Next m                       Inp4CSI.Visible = xlSheetHidden fmt.Visible = xlSheetHidden Exit Sub End If               End If            End If        End If    Next l

For j = 2 To 51 For k = 1 To 10 sheetBins.Cells(j, k).Value = "" Next k Next j MsgBox "Please select a format or edit in the sheet!", vbInformation + vbOKOnly, mConstants.sToolName

End If

Inp4CSI.Visible = xlSheetHidden fmt.Visible = xlSheetHidden

Call disableButtons End Sub

'BINS UPDATE COMMANDBUTTON TASKS Private Sub cmdUpdate_Click

Dim z, zz, maxRow, cntRowPSI, cntRowFmt, cntBinOld, cntBinOldPSI, cntBinNew, cntRowPSIagain, t, u, p, q, r, s As Integer Dim cntRowCSI, cntBinOldCSI, cntRowCSIagain As Integer Dim oldFmtName, newFmtName As String

fmt.Visible = xlSheetVisible Inp3PSI.Visible = xlSheetVisible Inp4CSI.Visible = xlSheetVisible

'UPDATE PSI BINS If fmtFlag = "PSI" Then maxRow = sheetBins.Cells(75, 2).Value For z = 2 To maxRow + 1 For zz = 2 To 9 If sheetBins.Cells(z, zz).Value = "" Then MsgBox "Some fields are missing! Please fill the blank cells", vbOKOnly + vbCritical fmt.Visible = xlSheetHidden Inp3PSI.Visible = xlSheetHidden Inp4CSI.Visible = xlSheetHidden Exit Sub End If       Next Next cntRowPSI = WorksheetFunction.CountA(Inp3PSI.Range("D:D")) cntRowFmt = WorksheetFunction.CountA(fmt.Range("A:A")) If comboPSIfmt.Value <> "" Then cntBinOld = WorksheetFunction.CountIf(fmt.Range("A:A"), comboPSIfmt.Value) cntBinOldPSI = WorksheetFunction.CountIf(Inp3PSI.Range("D:D"), comboPSIfmt.Value) Else cntBinOld = 0 cntBinOldPSI = 0 End If   If sheetBins.Cells(75, 1).Value >= 1 Then If sheetBins.Cells(32, 1).Value <> "" Then oldFmtName = UCase(sheetBins.Cells(32, 1).Value) End If       If oldFmtName = "" Then newFmtName = UCase(sheetBins.Cells(2, 1).Value) End If       If newFmtName = "" Then newFmtName = UCase(InputBox("Provide name for modified format", "New format", oldFmtName & "X")) If (newFmtName = "") Then 'If (newFmtName = "" Or newFmtName = False) Then MsgBox "You have not provided with a new format name!", vbInformation + vbOKOnly fmt.Visible = xlSheetHidden Inp3PSI.Visible = xlSheetHidden Inp4CSI.Visible = xlSheetHidden Exit Sub End If           'CHECK NEW FORMAT NAME If Len(newFmtName) > 32 Then MsgBox "Format name cannot have more than 32 characters", vbOKOnly + vbCritical fmt.Visible = xlSheetHidden Inp3PSI.Visible = xlSheetHidden Inp4CSI.Visible = xlSheetHidden Exit Sub End If           If IsNumeric(Right(newFmtName, 1)) = True Then MsgBox "Format name cannot end in a number", vbOKOnly + vbCritical fmt.Visible = xlSheetHidden Inp3PSI.Visible = xlSheetHidden Inp4CSI.Visible = xlSheetHidden Exit Sub End If           If WorksheetFunction.CountIf(fmt.Range("A:A"), newFmtName) <> Empty Then MsgBox "Format name already exists! Please try any other name", vbOKOnly + vbCritical fmt.Visible = xlSheetHidden Inp3PSI.Visible = xlSheetHidden Inp4CSI.Visible = xlSheetHidden Exit Sub End If       End If        cntBinNew = sheetBins.Cells(76, 1).Value For t = 32 To 51 For u = 1 To 10 sheetBins.Cells(t, u).Value = "" Next u       Next t        For p = 1 To cntBinNew sheetBins.Cells(p + 1, 1).Value = newFmtName fmt.Activate fmt.Cells(cntRowFmt + p, 1).Value = newFmtName fmt.Cells(cntRowFmt + p, 2).Value = sheetBins.Cells(p + 1, 2).Value fmt.Cells(cntRowFmt + p, 3).Value = sheetBins.Cells(p + 1, 3).Value 'fmt.Cells(cntRowFmt + p, 4).Value = sheetBins.Cells(p + 1, 4).Value fmt.Cells(cntRowFmt + p, 4).FormulaR1C1 = "=""[""&RC[-2]&""-""&RC[-1]&""]""" fmt.Cells(cntRowFmt + p, 5).Value = sheetBins.Cells(p + 1, 5).Value fmt.Cells(cntRowFmt + p, 6).Value = sheetBins.Cells(p + 1, 6).Value fmt.Cells(cntRowFmt + p, 7).Value = sheetBins.Cells(p + 1, 7).Value sheetBins.Cells(p + 31, 1).Value = newFmtName sheetBins.Cells(p + 31, 2).Value = sheetBins.Cells(p + 1, 2).Value sheetBins.Cells(p + 31, 3).Value = sheetBins.Cells(p + 1, 3).Value sheetBins.Cells(p + 31, 4).Value = sheetBins.Cells(p + 1, 4).Value sheetBins.Cells(p + 31, 5).Value = sheetBins.Cells(p + 1, 5).Value sheetBins.Cells(p + 31, 6).Value = sheetBins.Cells(p + 1, 6).Value sheetBins.Cells(p + 31, 7).Value = sheetBins.Cells(p + 1, 7).Value sheetBins.Cells(p + 31, 8).Value = sheetBins.Cells(p + 1, 8).Value sheetBins.Cells(p + 31, 9).Value = sheetBins.Cells(p + 1, 9).Value Next p       For q = 1 To cntRowPSI If UCase(Inp3PSI.Cells(q + 1, 1).Value) = UCase(comboScoreVariable.Value) Then If UCase(Inp3PSI.Cells(q + 1, 2).Value) = UCase(comboSegmentVariable.Value) Then If UCase(Inp3PSI.Cells(q + 1, 3).Value) = UCase(lstSegmentValue.List(SelSegIndx)) Then Inp3PSI.Activate For r = 1 To cntBinOld Inp3PSI.Rows(q + 1).Delete Next r                   Exit For End If               End If            End If        Next q        cntRowPSIagain = WorksheetFunction.CountA(Inp3PSI.Range("D:D")) For s = 1 To cntBinNew Inp3PSI.Cells(cntRowPSIagain + s, 1).Value = UCase(comboScoreVariable.Value) Inp3PSI.Cells(cntRowPSIagain + s, 2).Value = UCase(comboSegmentVariable.Value) Inp3PSI.Cells(cntRowPSIagain + s, 3).Value = UCase(lstSegmentValue.List(SelSegIndx)) Inp3PSI.Cells(cntRowPSIagain + s, 4).Value = newFmtName Inp3PSI.Cells(cntRowPSIagain + s, 5).Value = sheetBins.Cells(s + 1, 2).Value Inp3PSI.Cells(cntRowPSIagain + s, 6).Value = sheetBins.Cells(s + 1, 3).Value Inp3PSI.Cells(cntRowPSIagain + s, 7).Value = sheetBins.Cells(s + 1, 4).Value Inp3PSI.Cells(cntRowPSIagain + s, 8).Value = sheetBins.Cells(s + 1, 5).Value Inp3PSI.Cells(cntRowPSIagain + s, 9).Value = sheetBins.Cells(s + 1, 6).Value Inp3PSI.Cells(cntRowPSIagain + s, 10).Value = sheetBins.Cells(s + 1, 7).Value Inp3PSI.Cells(cntRowPSIagain + s, 11).Value = sheetBins.Cells(s + 1, 8).Value Inp3PSI.Cells(cntRowPSIagain + s, 12).Value = sheetBins.Cells(s + 1, 9).Value Next s       comboPSIfmt.AddItem (newFmtName) comboPSIfmt.Value = newFmtName Else cntBinNew = sheetBins.Cells(76, 1).Value mchFmt = WorksheetFunction.CountIf(fmt.Range("A:A"), comboPSIfmt.Value) 'mchFmt = WorksheetFunction.Match(comboPSIfmt.value, fmt.Range("A:A"), 0) If mchFmt = 0 Then fmt.Activate For p = 1 To cntBinNew fmt.Cells(cntRowFmt + p, 1).Value = sheetBins.Cells(p + 1, 1).Value fmt.Cells(cntRowFmt + p, 2).Value = sheetBins.Cells(p + 1, 2).Value fmt.Cells(cntRowFmt + p, 3).Value = sheetBins.Cells(p + 1, 3).Value 'fmt.Cells(cntRowFmt + p, 4).Value = sheetBins.Cells(p + 1, 4).Value fmt.Cells(cntRowFmt + p, 4).FormulaR1C1 = "=""[""&RC[-2]&""-""&RC[-1]&""]""" fmt.Cells(cntRowFmt + p, 5).Value = sheetBins.Cells(p + 1, 5).Value fmt.Cells(cntRowFmt + p, 6).Value = sheetBins.Cells(p + 1, 6).Value fmt.Cells(cntRowFmt + p, 7).Value = sheetBins.Cells(p + 1, 7).Value Next p       End If        For q = 1 To cntRowPSI If UCase(Inp3PSI.Cells(q + 1, 1).Value) = UCase(comboScoreVariable.Value) Then If UCase(Inp3PSI.Cells(q + 1, 2).Value) = UCase(comboSegmentVariable.Value) Then If UCase(Inp3PSI.Cells(q + 1, 3).Value) = UCase(lstSegmentValue.List(SelSegIndx)) Then Inp3PSI.Activate For r = 1 To cntBinOldPSI Inp3PSI.Rows(q + 1).Delete Next r                   Exit For End If               End If            End If        Next q        cntRowPSIagain = WorksheetFunction.CountA(Inp3PSI.Range("D:D")) For s = 1 To cntBinNew Inp3PSI.Cells(cntRowPSIagain + s, 1).Value = UCase(comboScoreVariable.Value) Inp3PSI.Cells(cntRowPSIagain + s, 2).Value = UCase(comboSegmentVariable.Value) Inp3PSI.Cells(cntRowPSIagain + s, 3).Value = UCase(lstSegmentValue.List(SelSegIndx)) Inp3PSI.Cells(cntRowPSIagain + s, 4).Value = sheetBins.Cells(s + 1, 1).Value Inp3PSI.Cells(cntRowPSIagain + s, 5).Value = sheetBins.Cells(s + 1, 2).Value Inp3PSI.Cells(cntRowPSIagain + s, 6).Value = sheetBins.Cells(s + 1, 3).Value Inp3PSI.Cells(cntRowPSIagain + s, 7).Value = sheetBins.Cells(s + 1, 4).Value Inp3PSI.Cells(cntRowPSIagain + s, 8).Value = sheetBins.Cells(s + 1, 5).Value Inp3PSI.Cells(cntRowPSIagain + s, 9).Value = sheetBins.Cells(s + 1, 6).Value Inp3PSI.Cells(cntRowPSIagain + s, 10).Value = sheetBins.Cells(s + 1, 7).Value Inp3PSI.Cells(cntRowPSIagain + s, 11).Value = sheetBins.Cells(s + 1, 8).Value Inp3PSI.Cells(cntRowPSIagain + s, 12).Value = sheetBins.Cells(s + 1, 9).Value Next s   End If    FreGroupLevel.Enabled = True FreScore.Enabled = True FreSegment.Enabled = True 'FreMetrics.Enabled = True FreBenchmark.Enabled = True If optSameYes.Value = False Then FrePeriod.Enabled = True End If   If optAlignYes.Value = False Then FreAlignmentParameters.Enabled = True End If   FreBins.Enabled = False cmdUpdate.Enabled = False cmdCancelBins.Enabled = False lstSegmentValue.Enabled = True cmdSegmentAdd.Enabled = True cmdSegmentDelete.Enabled = True End If

'UPDATE CSI BINS If fmtFlag = "CSI" Then maxRow = sheetBins.Cells(75, 2).Value For z = 2 To maxRow + 1 For zz = 2 To 10 If sheetBins.Cells(z, zz).Value = "" Then MsgBox "Some fields are missing! Please fill the blank cells", vbOKOnly + vbCritical fmt.Visible = xlSheetHidden Inp3PSI.Visible = xlSheetHidden Inp4CSI.Visible = xlSheetHidden Exit Sub End If       Next Next cntRowCSI = WorksheetFunction.CountA(Inp4CSI.Range("E:E")) cntRowFmt = WorksheetFunction.CountA(fmt.Range("A:A")) If sheetBins.Cells(75, 1).Value >= 1 Then If sheetBins.Cells(32, 1).Value <> "" Then oldFmtName = UCase(sheetBins.Cells(32, 1).Value) End If       If oldFmtName = "" Then newFmtName = UCase(sheetBins.Cells(2, 1).Value) End If       If newFmtName = "" Then newFmtName = UCase(InputBox("Provide name for modified format", "New format", oldFmtName & "X")) If (newFmtName = "" Or newFmtName = False) Then MsgBox "You have not provided with a new format name!", vbInformation + vbOKOnly fmt.Visible = xlSheetHidden Inp3PSI.Visible = xlSheetHidden Inp4CSI.Visible = xlSheetHidden Exit Sub End If           'CHECK NEW FORMAT NAME If sheetBins.Cells(2, 5).Value = "C" Then If Len(newFmtName) > 31 Then MsgBox "Character format name cannot have more than 31 characters", vbOKOnly + vbCritical fmt.Visible = xlSheetHidden Inp3PSI.Visible = xlSheetHidden Inp4CSI.Visible = xlSheetHidden Exit Sub End If           Else If Len(newFmtName) > 32 Then MsgBox "Format name cannot have more than 32 characters", vbOKOnly + vbCritical fmt.Visible = xlSheetHidden Inp3PSI.Visible = xlSheetHidden Inp4CSI.Visible = xlSheetHidden Exit Sub End If           End If            If IsNumeric(Right(newFmtName, 1)) = True Then MsgBox "Format name cannot end in a number", vbOKOnly + vbCritical fmt.Visible = xlSheetHidden Inp3PSI.Visible = xlSheetHidden Inp4CSI.Visible = xlSheetHidden Exit Sub End If           If WorksheetFunction.CountIf(fmt.Range("A:A"), newFmtName) <> Empty Then MsgBox "Format name already exists! Please try any other name", vbOKOnly + vbCritical fmt.Visible = xlSheetHidden Inp3PSI.Visible = xlSheetHidden Inp4CSI.Visible = xlSheetHidden Exit Sub End If       End If        cntBinNew = sheetBins.Cells(76, 1).Value For t = 32 To 51 For u = 1 To 10 sheetBins.Cells(t, u).Value = "" Next u       Next t        For p = 1 To cntBinNew sheetBins.Cells(p + 1, 1).Value = newFmtName fmt.Activate fmt.Cells(cntRowFmt + p, 1).Value = newFmtName fmt.Cells(cntRowFmt + p, 2).Value = sheetBins.Cells(p + 1, 2).Value fmt.Cells(cntRowFmt + p, 3).Value = sheetBins.Cells(p + 1, 3).Value 'fmt.Cells(cntRowFmt + p, 4).Value = sheetBins.Cells(p + 1, 4).Value fmt.Cells(cntRowFmt + p, 4).FormulaR1C1 = "=""[""&RC[-2]&""-""&RC[-1]&""]""" fmt.Cells(cntRowFmt + p, 5).Value = sheetBins.Cells(p + 1, 5).Value fmt.Cells(cntRowFmt + p, 6).Value = sheetBins.Cells(p + 1, 6).Value fmt.Cells(cntRowFmt + p, 7).Value = sheetBins.Cells(p + 1, 7).Value sheetBins.Cells(p + 31, 1).Value = newFmtName sheetBins.Cells(p + 31, 2).Value = sheetBins.Cells(p + 1, 2).Value sheetBins.Cells(p + 31, 3).Value = sheetBins.Cells(p + 1, 3).Value sheetBins.Cells(p + 31, 4).Value = sheetBins.Cells(p + 1, 4).Value sheetBins.Cells(p + 31, 5).Value = sheetBins.Cells(p + 1, 5).Value sheetBins.Cells(p + 31, 6).Value = sheetBins.Cells(p + 1, 6).Value sheetBins.Cells(p + 31, 7).Value = sheetBins.Cells(p + 1, 7).Value sheetBins.Cells(p + 31, 8).Value = sheetBins.Cells(p + 1, 8).Value sheetBins.Cells(p + 31, 9).Value = sheetBins.Cells(p + 1, 9).Value sheetBins.Cells(p + 31, 10).Value = sheetBins.Cells(p + 1, 10).Value Next p       For q = 1 To cntRowCSI If UCase(Inp4CSI.Cells(q + 1, 1).Value) = UCase(comboScoreVariable.Value) Then If UCase(Inp4CSI.Cells(q + 1, 2).Value) = UCase(comboSegmentVariable.Value) Then If UCase(Inp4CSI.Cells(q + 1, 3).Value) = UCase(lstSegmentValue.List(SelSegIndx)) Then If UCase(Inp4CSI.Cells(q + 1, 4).Value) = UCase(lstCharacteristicName.List(SelChrIndx)) Then Inp4CSI.Activate Inp4CSI.Rows(q + 1).Delete q = q - 1 End If                   End If                End If            End If        Next q        cntRowCSIagain = WorksheetFunction.CountA(Inp4CSI.Range("E:E")) For s = 1 To cntBinNew Inp4CSI.Cells(cntRowCSIagain + s, 1).Value = UCase(comboScoreVariable.Value) Inp4CSI.Cells(cntRowCSIagain + s, 2).Value = UCase(comboSegmentVariable.Value) Inp4CSI.Cells(cntRowCSIagain + s, 3).Value = UCase(lstSegmentValue.List(SelSegIndx)) Inp4CSI.Cells(cntRowCSIagain + s, 4).Value = UCase(lstCharacteristicName.List(SelChrIndx)) Inp4CSI.Cells(cntRowCSIagain + s, 5).Value = newFmtName Inp4CSI.Cells(cntRowCSIagain + s, 6).Value = sheetBins.Cells(s + 1, 2).Value Inp4CSI.Cells(cntRowCSIagain + s, 7).Value = sheetBins.Cells(s + 1, 3).Value Inp4CSI.Cells(cntRowCSIagain + s, 8).Value = sheetBins.Cells(s + 1, 4).Value Inp4CSI.Cells(cntRowCSIagain + s, 9).Value = sheetBins.Cells(s + 1, 5).Value Inp4CSI.Cells(cntRowCSIagain + s, 10).Value = sheetBins.Cells(s + 1, 6).Value Inp4CSI.Cells(cntRowCSIagain + s, 11).Value = sheetBins.Cells(s + 1, 7).Value Inp4CSI.Cells(cntRowCSIagain + s, 12).Value = sheetBins.Cells(s + 1, 8).Value Inp4CSI.Cells(cntRowCSIagain + s, 13).Value = sheetBins.Cells(s + 1, 9).Value Inp4CSI.Cells(cntRowCSIagain + s, 14).Value = sheetBins.Cells(s + 1, 10).Value Next s       comboCSIfmt.AddItem (newFmtName) comboCSIfmt.Value = newFmtName Else cntBinNew = sheetBins.Cells(76, 1).Value mchFmt = WorksheetFunction.CountIf(fmt.Range("A:A"), comboCSIfmt.Value) 'mchFmt = WorksheetFunction.Match(comboCSIfmt.value, fmt.Range("A:A"), 0) If mchFmt = 0 Then fmt.Activate For p = 1 To cntBinNew fmt.Cells(cntRowFmt + p, 1).Value = sheetBins.Cells(p + 1, 1).Value fmt.Cells(cntRowFmt + p, 2).Value = sheetBins.Cells(p + 1, 2).Value fmt.Cells(cntRowFmt + p, 3).Value = sheetBins.Cells(p + 1, 3).Value 'fmt.Cells(cntRowFmt + p, 4).Value = sheetBins.Cells(p + 1, 4).Value fmt.Cells(cntRowFmt + p, 4).FormulaR1C1 = "=""[""&RC[-2]&""-""&RC[-1]&""]""" fmt.Cells(cntRowFmt + p, 5).Value = sheetBins.Cells(p + 1, 5).Value fmt.Cells(cntRowFmt + p, 6).Value = sheetBins.Cells(p + 1, 6).Value fmt.Cells(cntRowFmt + p, 7).Value = sheetBins.Cells(p + 1, 7).Value Next p       End If        For q = 1 To cntRowCSI If UCase(Inp4CSI.Cells(q + 1, 1).Value) = UCase(comboScoreVariable.Value) Then If UCase(Inp4CSI.Cells(q + 1, 2).Value) = UCase(comboSegmentVariable.Value) Then If UCase(Inp4CSI.Cells(q + 1, 3).Value) = UCase(lstSegmentValue.List(SelSegIndx)) Then If UCase(Inp4CSI.Cells(q + 1, 4).Value) = UCase(lstCharacteristicName.List(SelChrIndx)) Then Inp4CSI.Activate Inp4CSI.Rows(q + 1).Delete q = q - 1 End If                   End If                End If            End If        Next q        cntRowCSIagain = WorksheetFunction.CountA(Inp4CSI.Range("D:D")) For s = 1 To cntBinNew Inp4CSI.Cells(cntRowCSIagain + s, 1).Value = UCase(comboScoreVariable.Value) Inp4CSI.Cells(cntRowCSIagain + s, 2).Value = UCase(comboSegmentVariable.Value) Inp4CSI.Cells(cntRowCSIagain + s, 3).Value = UCase(lstSegmentValue.List(SelSegIndx)) Inp4CSI.Cells(cntRowCSIagain + s, 4).Value = UCase(lstCharacteristicName.List(SelChrIndx)) Inp4CSI.Cells(cntRowCSIagain + s, 5).Value = sheetBins.Cells(s + 1, 1).Value Inp4CSI.Cells(cntRowCSIagain + s, 6).Value = sheetBins.Cells(s + 1, 2).Value Inp4CSI.Cells(cntRowCSIagain + s, 7).Value = sheetBins.Cells(s + 1, 3).Value Inp4CSI.Cells(cntRowCSIagain + s, 8).Value = sheetBins.Cells(s + 1, 4).Value Inp4CSI.Cells(cntRowCSIagain + s, 9).Value = sheetBins.Cells(s + 1, 5).Value Inp4CSI.Cells(cntRowCSIagain + s, 10).Value = sheetBins.Cells(s + 1, 6).Value Inp4CSI.Cells(cntRowCSIagain + s, 11).Value = sheetBins.Cells(s + 1, 7).Value Inp4CSI.Cells(cntRowCSIagain + s, 12).Value = sheetBins.Cells(s + 1, 8).Value Inp4CSI.Cells(cntRowCSIagain + s, 13).Value = sheetBins.Cells(s + 1, 9).Value Inp4CSI.Cells(cntRowCSIagain + s, 14).Value = sheetBins.Cells(s + 1, 10).Value

Next s   End If    FreGroupLevel.Enabled = True FreScore.Enabled = True FreSegment.Enabled = True FreCharacteristicVariable.Enabled = True FreBins.Enabled = False cmdUpdate.Enabled = False cmdCancelBins.Enabled = False Call enableButtons End If

sheetBins.Cells(2, 5).Select

fmt.Visible = xlSheetHidden Inp3PSI.Visible = xlSheetHidden Inp4CSI.Visible = xlSheetHidden

End Sub

'BINS CANCEL COMMANDBUTTON TASKS Private Sub cmdCancelBins_Click Dim j, k As Integer

For j = 2 To 51 For k = 1 To 10 sheetBins.Cells(j, k).Value = "" Next k Next j

'FreGroupLevel.Enabled = True 'FreScore.Enabled = True 'FreSegment.Enabled = True 'FreCharacteristicVariable.Enabled = True

FreBins.Enabled = False cmdUpdate.Enabled = False cmdCancelBins.Enabled = False If fmtFlag = "PSI" Then lstSegmentValue.Enabled = True cmdSegmentAdd.Enabled = True cmdSegmentDelete.Enabled = True End If If fmtFlag = "CSI" Then FreGroupLevel.Enabled = True FreScore.Enabled = True FreSegment.Enabled = True FreCharacteristicVariable.Enabled = True Call enableButtons End If

End Sub

'=============================== Execution logic ===========================

'INITIALIZE USERFORM Private Sub UserForm_Initialize Dim i, j, cntVar, cntFmt As Integer

'LOAD VARIABLE COMBOBOXES Call sortVariables var.Visible = xlSheetVisible cntVar = WorksheetFunction.CountA(var.Range("A:A")) For j = 2 To cntVar If var.Range("A" & j).Value <> var.Range("A" & j - 1) Then frmGroupView.comboSegmentVariable.AddItem (var.Range("A" & j).Value) frmGroupView.comboScoreVariable.AddItem (var.Range("A" & j).Value) frmGroupView.comboBad.AddItem (var.Range("A" & j).Value) End If Next j Inp0Button.Activate var.Visible = xlSheetHidden

'LOAD FORMAT COMBOBOXES fmt.Visible = xlSheetVisible fmt.Activate cntFmt = WorksheetFunction.CountA(fmt.Range("A:A")) For i = 2 To cntFmt If fmt.Range("A" & i).Value <> fmt.Range("A" & i - 1) Then frmGroupView.comboPSIfmt.AddItem (fmt.Range("A" & i).Value) frmGroupView.comboCSIfmt.AddItem (fmt.Range("A" & i).Value) End If Next i Inp0Button.Activate fmt.Visible = xlSheetHidden

'SET MAXIMUM LIMITS MaxGroup = 3 MaxScorecard = 5 MaxSegment = 25 MaxCharacteristic = 20

Flag = "LOAD" ScrFlag = "LOAD" SegFlag = "LOAD" charFlag = "LOAD" fmtFlag = "PSI"

SheetData.Visible = xlSheetVisible SheetData.Activate

Call RefreshGroupList(0) Call RefreshSegmentData Call RefreshScoreList Call RefreshScoreData Call RefreshSegmentList Call RefreshSegmentListData Call RefreshCharacteristicList Call RefreshBinsPSI Call RefreshBinsCSI If lstGroupName.ListCount > 0 Then lstGroupName.ListIndex = 0 End If Inp0Button.Activate SheetData.Visible = xlSheetHidden

If Inp0Button.Range("B14").Value = 1 Then FreGroupLevel.Enabled = False FreScore.Enabled = False FreSegment.Enabled = False FreCharacteristicVariable.Enabled = False FreScoreData.Enabled = False cmdComplete.Enabled = False cmdEditForm.Enabled = True End If

lblBadRate.Visible = False txtBadRate.Visible = False chkCharacLvlBadRt.Visible = False chkAccuracy.Visible = False cmdImport.Visible = False cmdCheck.Visible = False cmdAdvancedCheck.Visible = False

End Sub

'REFRESH GROUP LIST Sub RefreshGroupList(ByVal ListID As Integer) Dim i As Integer

lstGroupName.Clear

For i = 1 To MaxGroup If Trim(SheetData.Cells(CalculateCellRow(i), 1).Value) <> "" Then lstGroupName.AddItem (SheetData.Cells(CalculateCellRow(i), 1).Value) End If Next

If lstGroupName.ListCount > 0 Then If ListID < -1 Then ListID = -1 Else lstGroupName.ListIndex = ListID End If End If

'THIS MIGHT HELP WITH THE NO GROUP SELECTED PROBLEM If lstGroupName.ListCount > 0 Then lstGroupName.ListIndex = 0 FreScore.Enabled = True If lstScoreName.ListCount > 0 Then FreSegment.Enabled = True If (lstSegmentValue.ListCount > 0 And (chkCSI.Value = True Or chkVDI.Value = True)) Then FreCharacteristicVariable.Enabled = True Else FreCharacteristicVariable.Enabled = False End If   Else FreSegment.Enabled = False End If Else FreScore.Enabled = False FreSegment.Enabled = False FreCharacteristicVariable.Enabled = False End If

FreGroupLevel.Enabled = True

End Sub

'REFRESH SEGMENT VARIABLE NAMES Sub RefreshSegmentData 'txtSegmentName.Text = "" comboSegmentVariable.Value = ""

If lstGroupName.ListIndex >= 0 Then 'If Trim(SheetData.Cells(CalculateCellRow(lstGroupName.ListIndex + 1), 2).Value) <> "" Then '   txtSegmentName.Text = SheetData.Cells(CalculateCellRow(lstGroupName.ListIndex + 1), 2).Value 'End If       If Trim(SheetData.Cells(CalculateCellRow(lstGroupName.ListIndex + 1), 3).Value) <> "" Then comboSegmentVariable.Value = SheetData.Cells(CalculateCellRow(lstGroupName.ListIndex + 1), 3).Value End If   End If End Sub

'REFRESH SCORE LIST FOR EACH GROUP Sub RefreshScoreList Dim i As Integer

lstScoreName.Clear

For i = 1 To MaxScorecard If lstGroupName.ListIndex >= 0 Then If Trim(SheetData.Cells(CalculateCellRowScore(lstGroupName.ListIndex + 1, i), 4).Value) <> "" Then lstScoreName.AddItem (SheetData.Cells(CalculateCellRowScore(lstGroupName.ListIndex + 1, i), 4).Value) End If   End If Next If lstScoreName.ListCount > 0 Then lstScoreName.ListIndex = 0 FreSegment.Enabled = True If (lstSegmentValue.ListCount > 0 And (chkCSI.Value = True Or chkVDI.Value = True)) Then FreCharacteristicVariable.Enabled = True Else FreCharacteristicVariable.Enabled = False End If Else FreSegment.Enabled = False FreCharacteristicVariable.Enabled = False End If

FreGroupLevel.Enabled = True 'FreScore.Enabled = True

End Sub

'REFRESH SCORE VARIABLE,UPPER/LOWER BOUND AND BAD DEFINITION Sub RefreshScoreData Dim StartRange As Integer Call clearScoreData

If lstGroupName.ListIndex >= 0 Then If lstScoreName.ListIndex >= 0 Then StartRange = CalculateCellRowScore(lstGroupName.ListIndex + 1, lstScoreName.ListIndex + 1) comboScoreVariable.Value = SheetData.Cells(StartRange, 5).Value comboBad.Value = SheetData.Cells(StartRange, 6).Value txtScoreLowerBound.Text = SheetData.Cells(StartRange, 7).Value txtScoreUpperBound.Text = SheetData.Cells(StartRange, 8).Value optScoreExcludeMissingYes.Value = SheetData.Cells(StartRange, 9).Value optScoreExcludeMissingNo.Value = Not (optScoreExcludeMissingYes.Value) chkPSI.Value = SheetData.Cells(StartRange, 10).Value chkVDI.Value = SheetData.Cells(StartRange, 11).Value chkCSI.Value = SheetData.Cells(StartRange, 12).Value chkKS.Value = SheetData.Cells(StartRange, 13).Value chkGini.Value = SheetData.Cells(StartRange, 14).Value chkDivergence.Value = SheetData.Cells(StartRange, 15).Value chkBadRate.Value = SheetData.Cells(StartRange, 16).Value chkGainsTable.Value = SheetData.Cells(StartRange, 17).Value chkAvgScoreGoods.Value = SheetData.Cells(StartRange, 18).Value chkAvgScoreBads.Value = SheetData.Cells(StartRange, 19).Value chkCharacLvlBadRt.Value = SheetData.Cells(StartRange, 20).Value chkOddsAtBaseScore.Value = SheetData.Cells(StartRange, 21).Value chkPDO.Value = SheetData.Cells(StartRange, 22).Value chkAlignmentTable.Value = SheetData.Cells(StartRange, 23).Value optSameYes.Value = SheetData.Cells(StartRange, 47).Value optSameNo.Value = Not (optSameYes.Value) If optSameYes.Value = True Then txtImplementationDate.Text = SheetData.Cells(StartRange, 27).Value txtPSIBenchmarkPeriod.Text = SheetData.Cells(StartRange, 28).Value txtCSIBenchmarkPeriod.Text = SheetData.Cells(StartRange, 29).Value txtStrengthBenchmarkPeriod.Text = SheetData.Cells(StartRange, 30).Value txtAlignmentBenchmarkPeriod.Text = SheetData.Cells(StartRange, 31).Value txtPSICurrentPeriod.Text = SheetData.Cells(StartRange, 32).Value txtCSICurrentPeriod.Text = SheetData.Cells(StartRange, 33).Value txtStrengthCurrentPeriod.Text = SheetData.Cells(StartRange, 34).Value txtAlignmentCurrentPeriod.Text = SheetData.Cells(StartRange, 34).Value End If           optAlignYes.Value = SheetData.Cells(StartRange, 48).Value optAlignNo.Value = Not (optAlignYes.Value) If optAlignYes.Value = True Then txtAlignmentBaseScore.Text = SheetData.Cells(StartRange, 24).Value txtOddsAtBaseScore.Text = SheetData.Cells(StartRange, 25).Value txtPDO.Text = SheetData.Cells(StartRange, 26).Value End If       End If    End If    'FreMetrics.Enabled = False 'FreBenchmark.Enabled = False FrePeriod.Enabled = False FreAlignmentParameters.Enabled = False FreScoreData.Enabled = False 'freScoreExcludeMissing.Enabled = False 'FrePeriodYesNo.Enabled = False 'FreScoreFmt.Enabled = False comboPSIfmt.Enabled = False cmdPSIfmt.Enabled = False 'FreBins.Enabled = False If (chkCSI.Value = True Or chkVDI.Value = True) Then lblChkCSIVDI.Visible = False Else lblChkCSIVDI.Visible = True End If   'CHECK THIS: MIGHT NEED TO BE UNCOMMENTED 'If (lstSegmentValue.ListCount > 0 And (chkCSI.Value = True Or chkVDI.Value = True)) Then '   FreCharacteristicVariable.Enabled = True 'Else '   FreCharacteristicVariable.Enabled = False 'End If   FreGroupLevel.Enabled = True End Sub

'REFRESH SEGMENT LIST Sub RefreshSegmentList

lstSegmentValue.Clear

For i = 1 To MaxSegment If lstGroupName.ListIndex >= 0 Then If lstScoreName.ListIndex >= 0 Then If Trim(SheetData.Cells(CalculateCellRowSegment(lstGroupName.ListIndex + 1, lstScoreName.ListIndex + 1, i), 36).Value) <> "" Then lstSegmentValue.AddItem (SheetData.Cells(CalculateCellRowSegment(lstGroupName.ListIndex + 1, lstScoreName.ListIndex + 1, i), 36).Value) End If       End If    End If Next

If lstSegmentValue.ListCount > 0 Then lstSegmentValue.ListIndex = 0 If (chkCSI.Value = True Or chkVDI.Value = True) Then FreCharacteristicVariable.Enabled = True End If   'Call chkCSIVDI Else FreCharacteristicVariable.Enabled = False End If

'FreGroupLevel.Enabled = True 'FreScore.Enabled = True 'FreSegment.Enabled = True

End Sub

'REFRESH SEGMENT LIST DATA Sub RefreshSegmentListData

Call clearSegmentValueData

If lstGroupName.ListIndex >= 0 Then If lstScoreName.ListIndex >= 0 Then If lstSegmentValue.ListIndex >= 0 Then StartRange = CalculateCellRowSegment(lstGroupName.ListIndex + 1, lstScoreName.ListIndex + 1, lstSegmentValue.ListIndex + 1) If optAlignYes.Value = False Then txtAlignmentBaseScore.Text = SheetData.Cells(StartRange, 24).Value txtPDO.Text = SheetData.Cells(StartRange, 25).Value txtOddsAtBaseScore.Text = SheetData.Cells(StartRange, 26).Value End If           If optSameYes.Value = False Then txtImplementationDate.Text = SheetData.Cells(StartRange, 27).Value txtPSIBenchmarkPeriod.Text = SheetData.Cells(StartRange, 28).Value txtCSIBenchmarkPeriod.Text = SheetData.Cells(StartRange, 29).Value txtStrengthBenchmarkPeriod.Text = SheetData.Cells(StartRange, 30).Value txtAlignmentBenchmarkPeriod.Text = SheetData.Cells(StartRange, 31).Value txtPSICurrentPeriod.Text = SheetData.Cells(StartRange, 32).Value txtCSICurrentPeriod.Text = SheetData.Cells(StartRange, 33).Value txtStrengthCurrentPeriod.Text = SheetData.Cells(StartRange, 34).Value txtAlignmentCurrentPeriod.Text = SheetData.Cells(StartRange, 35).Value End If           txtBenchmarkKS.Text = SheetData.Cells(StartRange, 37).Value txtBenchmarkTrueKS.Text = SheetData.Cells(StartRange, 38).Value txtBenchmarkGini.Text = SheetData.Cells(StartRange, 39).Value txtBenchmarkDivergence.Text = SheetData.Cells(StartRange, 40).Value txtBadRate.Text = SheetData.Cells(StartRange, 41).Value txtAverageGoodScore.Text = SheetData.Cells(StartRange, 42).Value txtAverageBadScore.Text = SheetData.Cells(StartRange, 43).Value End If   End If End If

'FreGroupLevel.Enabled = True 'FreScore.Enabled = True

FreMetrics.Enabled = False FreBenchmark.Enabled = False FrePeriod.Enabled = False FreAlignmentParameters.Enabled = False 'FreScoreFmt.Enabled = False comboPSIfmt.Enabled = False cmdPSIfmt.Enabled = False 'FreBins.Enabled = False

If (lstSegmentValue.ListCount > 0 And (chkCSI.Value = True Or chkVDI.Value = True)) Then FreCharacteristicVariable.Enabled = True Else FreCharacteristicVariable.Enabled = False End If

End Sub

'REFRESH CHARACTERISTIC LIST Public Sub RefreshCharacteristicList Dim i As Integer

lstCharacteristicName.Clear

For i = 1 To MaxCharacteristic If lstGroupName.ListIndex >= 0 And lstScoreName.ListIndex >= 0 And lstSegmentValue.ListIndex >= 0 Then If Trim(SheetData.Cells(CalculateCellRowCharacteristic(lstGroupName.ListIndex + 1, lstScoreName.ListIndex + 1, lstSegmentValue.ListIndex + 1, i), 44).Value) <> "" Then lstRow = CalculateCellRowCharacteristic(lstGroupName.ListIndex + 1, lstScoreName.ListIndex + 1, lstSegmentValue.ListIndex + 1, i)           lstCharacteristicName.AddItem (SheetData.Cells(lstRow, 44).Value) lstCharacteristicName.List(i - 1, 1) = (SheetData.Cells(lstRow, 45).Value) lstCharacteristicName.List(i - 1, 2) = (SheetData.Cells(lstRow, 46).Value) End If   End If Next

If lstCharacteristicName.ListCount > 0 Then 'lstCharacteristicName.ListIndex = 0 FreCharacteristicVariable.Enabled = True 'cmdDescription.Enabled = True 'comboCSIfmt.Enabled = True 'cmdCSIfmt.Enabled = True End If comboCSIfmt.Value = "" 'FreGroupLevel.Enabled = True 'FreScore.Enabled = True 'FreSegment.Enabled = True

End Sub

'REFRESH PSI BINS Sub RefreshBinsPSI Dim j, k, l, m, cntRow, cntBinPSI, cntBinPSIagain As Integer

cntRow = WorksheetFunction.CountA(Inp3PSI.Range("D:D")) cntBinPSI = WorksheetFunction.CountIf(Inp3PSI.Range("D:D"), comboPSIfmt.Value)

If cntBinPSI > 20 Then cntBinPSI = 1 End If

For j = 2 To 51 For k = 1 To 10 sheetBins.Cells(j, k).Value = "" Next k Next j If cntBinPSI > 0 Then For l = 2 To cntRow If UCase(Inp3PSI.Cells(l, 1).Value) = UCase(comboScoreVariable.Value) Then If UCase(Inp3PSI.Cells(l, 2).Value) = UCase(comboSegmentVariable.Value) Then If UCase(Inp3PSI.Cells(l, 3).Value) = UCase(lstSegmentValue.List(SelSegIndx)) Then comboPSIfmt.Value = UCase(Inp3PSI.Cells(l, 4).Value) FreBins.Caption = "PSI Bins for score:" & UCase(lstScoreName.List(SelScrIndx)) & " segment:" & UCase(lstSegmentValue.List(SelSegIndx)) cntBinPSIagain = WorksheetFunction.CountIf(Inp3PSI.Range("D:D"), comboPSIfmt.Value) For m = 1 To cntBinPSIagain sheetBins.Cells(m + 1, 1).Value = Inp3PSI.Cells(l + m - 1, 4).Value sheetBins.Cells(m + 1, 2).Value = Inp3PSI.Cells(l + m - 1, 5).Value sheetBins.Cells(m + 1, 3).Value = Inp3PSI.Cells(l + m - 1, 6).Value sheetBins.Cells(m + 1, 4).Value = Inp3PSI.Cells(l + m - 1, 7).Value sheetBins.Cells(m + 1, 5).Value = Inp3PSI.Cells(l + m - 1, 8).Value sheetBins.Cells(m + 1, 6).Value = Inp3PSI.Cells(l + m - 1, 9).Value sheetBins.Cells(m + 1, 7).Value = Inp3PSI.Cells(l + m - 1, 10).Value sheetBins.Cells(m + 1, 8).Value = Inp3PSI.Cells(l + m - 1, 11).Value sheetBins.Cells(m + 1, 9).Value = Inp3PSI.Cells(l + m - 1, 12).Value sheetBins.Cells(m + 31, 1).Value = Inp3PSI.Cells(l + m - 1, 4).Value sheetBins.Cells(m + 31, 2).Value = Inp3PSI.Cells(l + m - 1, 5).Value sheetBins.Cells(m + 31, 3).Value = Inp3PSI.Cells(l + m - 1, 6).Value sheetBins.Cells(m + 31, 4).Value = Inp3PSI.Cells(l + m - 1, 7).Value sheetBins.Cells(m + 31, 5).Value = Inp3PSI.Cells(l + m - 1, 8).Value sheetBins.Cells(m + 31, 6).Value = Inp3PSI.Cells(l + m - 1, 9).Value sheetBins.Cells(m + 31, 7).Value = Inp3PSI.Cells(l + m - 1, 10).Value sheetBins.Cells(m + 31, 8).Value = Inp3PSI.Cells(l + m - 1, 11).Value sheetBins.Cells(m + 31, 9).Value = Inp3PSI.Cells(l + m - 1, 12).Value Next m                   Exit Sub End If           End If        End If    Next l End If End Sub

'REFRESH CSI BINS Sub RefreshBinsCSI Dim j, k, l, m, cntRow As Integer

cntRow = WorksheetFunction.CountA(Inp4CSI.Range("E:E"))

If fmtFlag = "CSI" Then For j = 2 To 51 For k = 1 To 10 sheetBins.Cells(j, k).Value = "" Next k   Next j    m = 0 For l = 2 To cntRow If UCase(Inp4CSI.Cells(l, 1).Value) = UCase(comboScoreVariable.Value) Then If UCase(Inp4CSI.Cells(l, 2).Value) = UCase(comboSegmentVariable.Value) Then If UCase(Inp4CSI.Cells(l, 3).Value) = UCase(lstSegmentValue.List(SelSegIndx)) Then If UCase(Inp4CSI.Cells(l, 4).Value) = UCase(lstCharacteristicName.List(SelChrIndx)) Then comboCSIfmt.Value = UCase(Inp4CSI.Cells(l, 5).Value) FreBins.Caption = "CSI Bins for " & UCase(lstCharacteristicName.List(SelChrIndx)) m = m + 1 sheetBins.Cells(m + 1, 1).Value = Inp4CSI.Cells(l, 5).Value sheetBins.Cells(m + 1, 2).Value = Inp4CSI.Cells(l, 6).Value sheetBins.Cells(m + 1, 3).Value = Inp4CSI.Cells(l, 7).Value sheetBins.Cells(m + 1, 4).Value = Inp4CSI.Cells(l, 8).Value sheetBins.Cells(m + 1, 5).Value = Inp4CSI.Cells(l, 9).Value sheetBins.Cells(m + 1, 6).Value = Inp4CSI.Cells(l, 10).Value sheetBins.Cells(m + 1, 7).Value = Inp4CSI.Cells(l, 11).Value sheetBins.Cells(m + 1, 8).Value = Inp4CSI.Cells(l, 12).Value sheetBins.Cells(m + 1, 9).Value = Inp4CSI.Cells(l, 13).Value sheetBins.Cells(m + 1, 10).Value = Inp4CSI.Cells(l, 14).Value sheetBins.Cells(m + 31, 1).Value = Inp4CSI.Cells(l, 5).Value sheetBins.Cells(m + 31, 2).Value = Inp4CSI.Cells(l, 6).Value sheetBins.Cells(m + 31, 3).Value = Inp4CSI.Cells(l, 7).Value sheetBins.Cells(m + 31, 4).Value = Inp4CSI.Cells(l, 8).Value sheetBins.Cells(m + 31, 5).Value = Inp4CSI.Cells(l, 9).Value sheetBins.Cells(m + 31, 6).Value = Inp4CSI.Cells(l, 10).Value sheetBins.Cells(m + 31, 7).Value = Inp4CSI.Cells(l, 11).Value sheetBins.Cells(m + 31, 8).Value = Inp4CSI.Cells(l, 12).Value sheetBins.Cells(m + 31, 9).Value = Inp4CSI.Cells(l, 13).Value sheetBins.Cells(m + 31, 10).Value = Inp4CSI.Cells(l, 14).Value End If               End If            End If        End If    Next l ElseIf fmtFlag = "PSI" Then FreBins.Enabled = False cmdDescription.Enabled = False comboCSIfmt.Enabled = False cmdCSIfmt.Enabled = False For l = 2 To cntRow If UCase(Inp4CSI.Cells(l, 1).Value) = UCase(comboScoreVariable.Value) Then If UCase(Inp4CSI.Cells(l, 2).Value) = UCase(comboSegmentVariable.Value) Then If UCase(Inp4CSI.Cells(l, 3).Value) = UCase(lstSegmentValue.List(SelSegIndx)) Then If UCase(Inp4CSI.Cells(l, 4).Value) = UCase(lstCharacteristicName.List(0)) Then comboCSIfmt.Value = UCase(Inp4CSI.Cells(l, 5).Value) End If               End If            End If        End If    Next l End If

End Sub

'CLEAR SCORE LEVEL DATA Sub clearScoreData comboScoreVariable.Value = "" comboBad.Value = "" txtScoreLowerBound.Value = "" txtScoreUpperBound.Value = "" optScoreExcludeMissingYes.Value = "" chkPSI.Value = "" chkVDI.Value = "" chkCSI.Value = "" chkKS.Value = "" chkPDO.Value = "" chkGini.Value = "" chkGainsTable.Value = "" chkDivergence.Value = "" chkBadRate.Value = "" chkAvgScoreGoods.Value = "" chkAvgScoreBads.Value = "" chkOddsAtBaseScore.Value = "" chkAlignmentTable.Value = "" chkCharacLvlBadRt.Value = "" optSameYes.Value = "" txtImplementationDate.Value = "" txtPSIBenchmarkPeriod.Value = "" txtStrengthBenchmarkPeriod.Value = "" txtPSICurrentPeriod.Value = "" txtStrengthCurrentPeriod.Value = "" txtCSIBenchmarkPeriod.Value = "" txtAlignmentBenchmarkPeriod.Value = "" txtCSICurrentPeriod.Value = "" txtAlignmentCurrentPeriod.Value = "" optAlignYes.Value = "" txtAlignmentBaseScore.Value = "" txtOddsAtBaseScore.Value = "" txtPDO.Value = "" End Sub

'DEFAULT SCORE LEVEL DATA Sub defaultScoreData comboScoreVariable.Value = "" comboBad.Value = "" txtScoreLowerBound.Value = "" txtScoreUpperBound.Value = "" optScoreExcludeMissingYes.Value = True 'WHY THIS KOLAVERI DI? 'chkPSI.Value = False chkPSI.Value = True chkVDI.Value = False chkCSI.Value = False chkKS.Value = True chkGini.Value = True chkDivergence.Value = True chkBadRate.Value = True chkGainsTable.Value = True chkAvgScoreGoods.Value = True chkAvgScoreBads.Value = True chkCharacLvlBadRt.Value = False 'chkOddsAtBaseScore.Value = True chkOddsAtBaseScore.Value = False chkAlignmentTable.Value = False chkPDO.Value = False optSameYes.Value = True txtImplementationDate.Value = "" txtPSIBenchmarkPeriod.Value = "" txtStrengthBenchmarkPeriod.Value = "" txtPSICurrentPeriod.Value = "" txtStrengthCurrentPeriod.Value = "" txtCSIBenchmarkPeriod.Value = "" txtAlignmentBenchmarkPeriod.Value = "" txtCSICurrentPeriod.Value = "" txtAlignmentCurrentPeriod.Value = "" optAlignYes.Value = True txtAlignmentBaseScore.Value = "" txtOddsAtBaseScore.Value = "" txtPDO.Value = "" End Sub

'CLEAR SEGMENT LEVEL DATA Sub clearSegmentValueData comboPSIfmt.Value = "" txtBenchmarkKS.Value = "" txtBenchmarkTrueKS.Value = "" txtBenchmarkGini.Value = "" txtBenchmarkDivergence.Value = "" txtAverageGoodScore.Value = "" txtAverageBadScore.Value = "" End Sub

'DEFAULT SEGMENT LEVEL DATA Sub defaultSegmentValueData comboPSIfmt.Value = "" txtBenchmarkKS.Value = "" txtBenchmarkTrueKS.Value = "" txtBenchmarkGini.Value = "" txtBenchmarkDivergence.Value = "" txtAverageGoodScore.Value = "" txtAverageBadScore.Value = "" lstCharacteristicName.Clear End Sub

'SORT SEGMENT LEVEL WORKSHEETS Sub sortSegmentSheets Inp3PSI.Visible = xlSheetVisible Inp3PSI.Activate Inp3PSI.Range("A:L").Select Selection.Sort _ Key1:=Range("B2"), Order1:=xlAscending, _ Key2:=Range("A2"), Order2:=xlAscending, _ Key3:=Range("C2"), Order3:=xlAscending, _ Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, DataOption3:=xlSortNormal

Inp3PSI.Range("A1").Select Inp3PSI.Visible = xlSheetHidden End Sub

'SORT CHARACTERISTIC LEVEL WORKSHEETS Sub sortCharacteristicSheets Inp4CSI.Visible = xlSheetVisible Inp4CSI.Activate Inp4CSI.Range("A:Q").Select Selection.Sort _ Key1:=Range("B2"), Order1:=xlAscending, _ Key2:=Range("A2"), Order2:=xlAscending, _ Key3:=Range("C2"), Order3:=xlAscending, _ Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, DataOption3:=xlSortNormal

Inp4CSI.Range("A1").Select Inp4CSI.Visible = xlSheetHidden End Sub

'SORT VARIABLES SHEET Sub sortVariables var.Visible = xlSheetVisible var.Activate var.Range("A:C").Select Selection.Sort _ Key1:=Range("A2"), Order1:=xlAscending, Header:=xlYes, OrderCustom:=1, _ MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

var.Range("A1").Select var.Visible = xlSheetHidden End Sub

'CALCULATE ROW IDENTIFIERS AT DIFFERENT LEVELS

Function CalculateCellRow(ByVal invalue As Integer) As Integer CalculateCellRow = (invalue - 1) * 2500 + 10 End Function

Function CalculateCellRowScore(ByVal invalueGrp As Integer, ByVal invalueScr As Integer) As Integer CalculateCellRowScore = (invalueGrp - 1) * 2500 + 10 + (invalueScr - 1) * 500 End Function

Function CalculateCellRowSegment(ByVal invalueGrp As Integer, ByVal invalueScr As Integer, ByVal invalueSeg As Integer) As Integer CalculateCellRowSegment = (invalueGrp - 1) * 2500 + 10 + (invalueScr - 1) * 500 + (invalueSeg - 1) * 20 End Function

Function CalculateCellRowCharacteristic(ByVal invalueGrp As Integer, ByVal invalueScr As Integer, ByVal invalueSeg As Integer, ByVal invalueChr As Integer) As Integer CalculateCellRowCharacteristic = (invalueGrp - 1) * 2500 + 10 + (invalueScr - 1) * 500 + (invalueSeg - 1) * 20 + (invalueChr - 1) End Function

'CSI FORMATS Private Sub comboCSIfmt_Change comboCSIfmt.BackColor = &H80000005 End Sub

Private Sub lstCharacteristicName_Click Call lstCharacteristicName_Change End Sub

Private Sub lstCharacteristicName_Change Dim k As Integer

fmtFlag = "CSI"

For k = 0 To lstCharacteristicName.ListCount - 1 If lstCharacteristicName.Selected(k) = True Then SelChrIndx = k   End If Next

'THIS WILL THROW ERROR 'Call RefreshCharacteristicList comboCSIfmt.Value = "" comboCSIfmt.BackColor = &H80000005 FreBins.Caption = "PSI/CSI Bins"

If lstCharacteristicName.ListIndex >= 0 Then Call RefreshBinsCSI cmdDescription.Enabled = True comboCSIfmt.Enabled = True cmdCSIfmt.Enabled = True FreBins.Enabled = True cmdUpdate.Enabled = True cmdCancelBins.Enabled = True If comboCSIfmt.Value = "" Then comboCSIfmt.BackColor = &HC0FFFF End If End If End Sub

'DISABLE X BUTTON ON USERFORM Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) If CloseMode = vbFormControlMenu Then Cancel = True MsgBox "You can't close the form like this! Please use the buttons on the form" End If End Sub

'EDIT FORM Private Sub cmdEditForm_Click Inp0Button.Range("B14").Value = 0 cmdComplete.Enabled = True cmdEditForm.Enabled = False 'cmdClearAll.Enabled = True Call UserForm_Initialize End Sub

'CLOSE USERFORM. DIFFICULTY WITH SETTING PUBLIC VARIABLE Public Sub cmdCloseForm_Click Inp0Button.Range("B10").Value = 0 If cmdAdd.Caption = "SAVE" Or cmdEdit.Caption = "SAVE" Or cmdScoreAdd.Caption = "SAVE" Or cmdScoreEdit.Caption = "SAVE" Or cmdSegmentAdd.Caption = "SAVE" Or cmdSegmentEdit.Caption = "SAVE" Then MsgBox "Please save the changes before closing the form!", vbCritical + vbOKOnly, mConstants.sToolName Exit Sub End If   frmGroupView.Hide Unload frmGroupView Inp0Button.cmdGroup.Enabled = True 'Inp0Button.cmdSuite.Enabled = True Inp0Button.cmdSuite.Enabled = False Inp0Button.cmdVariables.Enabled = True Inp0Button.cmdFormats.Enabled = True 'ThisWorkbook.Save End Sub

'FORM COMPLETE Private Sub cmdComplete_Click Inp0Button.Range("B10").Value = 0

If cmdAdd.Caption = "SAVE" Or cmdEdit.Caption = "SAVE" Or cmdScoreAdd.Caption = "SAVE" Or cmdScoreEdit.Caption = "SAVE" Or cmdSegmentAdd.Caption = "SAVE" Or cmdSegmentEdit.Caption = "SAVE" Then MsgBox "Please save the changes!", vbCritical + vbOKOnly, mConstants.sToolName Exit Sub End If

If MsgBox("Have you entered all required information?", vbQuestion + vbYesNo, mConstants.sToolName) = vbYes Then 'REMOVE PERIODS @ SEGMENT LEVEL IF PERIODS ARE @ SCORE LEVEL Call inspectPeriods 'FILL DETAILS Call mFill.fillDetails 'REPLACE LOW AND HIGH Call mFill.Replace_Low_High 'DELETE ROWS WITH **OTHER** : NOT REQUIRED 'Call mFill.Delete_Rows_Other frmGroupView.Hide Unload frmGroupView Inp0Button.Range("B14").Value = 1 Else Inp0Button.Range("B10").Value = 1 End If

Inp0Button.cmdGroup.Enabled = True ThisWorkbook.Save End Sub

'HIDE USERFORM FOR COPYING FROM ANY OTHER SOURCE Private Sub cmdCopy_Click

'Inp0Button.Range("F10:I11").Interior.ColorIndex = 6 'Inp0Button.Range("F10:I11").Interior.Pattern = xlSolid 'Inp0Button.Range("F10:I11").Font.ColorIndex = 3

Inp0Button.cmdGroup.Enabled = False Inp0Button.cmdSuite.Enabled = False Inp0Button.cmdVariables.Enabled = False Inp0Button.cmdFormats.Enabled = False

Inp0Button.Range("B10").Value = 1 frmGroupView.Hide

End Sub

'SWITCH TO PSI VIEW Private Sub cmdToggle_Click

FreBins.Enabled = False cmdUpdate.Enabled = False cmdCancelBins.Enabled = False

FreBins.Caption = "PSI/CSI Bins" Call RefreshBinsPSI

End Sub

Sub inspectPeriods Dim i, j, startRow, endRow As Integer

SheetData.Visible = xlSheetVisible SheetData.Activate

For i = 0 To lstGroupName.ListCount - 1 For j = 0 To lstScoreName.ListCount - 1 If SheetData.Cells(CalculateCellRowScore(i + 1, j + 1), 47).Value = True Then startRow = CalculateCellRowScore(i + 1, j + 1) + 1 endRow = CalculateCellRowScore(i + 1, j + 2) - 1 SheetData.Range(Cells(startRow, 28), Cells(endRow, 35)).Select Selection.ClearContents End If   Next j Next i

SheetData.Visible = xlSheetHidden End Sub

'BASIC CHECKS (!?) Private Sub cmdCheck_Click

End Sub

'SAVE FILE Private Sub cmdSaveFile_Click ThisWorkbook.Save End Sub

'CLEAR ALL DATA Private Sub cmdClearAll_Click Dim j, k As Integer

If MsgBox("Are you sure you want to clear everything?", vbQuestion + vbYesNo) = vbYes Then

'UNHIDE SHEETS Sourcedata.Visible = xlSheetVisible GlobalForm.Visible = xlSheetVisible SheetData.Visible = xlSheetVisible Inp1GDS.Visible = xlSheetVisible Inp2GDC.Visible = xlSheetVisible Inp3PSI.Visible = xlSheetVisible Inp4CSI.Visible = xlSheetVisible fmt.Visible = xlSheetVisible var.Visible = xlSheetVisible

'DELETE EVERYTHING Sourcedata.Activate Sourcedata.Range("A2:AZ40000").Select Selection.ClearContents Sourcedata.Range("A1").Select

GlobalForm.Activate GlobalForm.Range("A2:AZ40000").Select Selection.ClearContents GlobalForm.Range("A1").Select

SheetData.Activate SheetData.Range("A2:AZ40000").Select Selection.ClearContents SheetData.Range("A1").Select

Inp1GDS.Activate Inp1GDS.Range("A2:AZ40000").Select Selection.ClearContents Inp1GDS.Range("A1").Select

Inp2GDC.Activate Inp2GDC.Range("A2:AZ40000").Select Selection.ClearContents Inp2GDC.Range("A1").Select

Inp3PSI.Activate Inp3PSI.Range("A2:AZ40000").Select Selection.ClearContents Inp3PSI.Range("A1").Select

Inp4CSI.Activate Inp4CSI.Range("A2:AZ40000").Select Selection.ClearContents Inp4CSI.Range("A1").Select

fmt.Activate fmt.Range("A2:AZ40000").Select Selection.ClearContents fmt.Range("A1").Select

var.Activate var.Range("A2:AZ40000").Select Selection.ClearContents var.Range("A1").Select

Inp0Button.Activate Inp0Button.Range("A1").Select Inp0Button.Range("B10").Value = 0 Inp0Button.Range("B14").Value = 0

'HIDE SHEETS Sourcedata.Visible = xlSheetHidden GlobalForm.Visible = xlSheetHidden SheetData.Visible = xlSheetHidden Inp1GDS.Visible = xlSheetHidden Inp2GDC.Visible = xlSheetHidden Inp3PSI.Visible = xlSheetHidden Inp4CSI.Visible = xlSheetHidden fmt.Visible = xlSheetHidden var.Visible = xlSheetHidden

'CLEAR DATA FROM FORM Call RefreshGroupList(0)

'CLEAR DATA FROM PSI/CSI BINS For j = 2 To 51 For k = 1 To 10 sheetBins.Cells(j, k).Value = "" Next k Next j

comboSegmentVariable.Clear comboScoreVariable.Clear comboBad.Clear comboPSIfmt.Clear comboCSIfmt.Clear

frmGroupView.Hide Unload frmGroupView

Inp0Button.cmdGroup.Enabled = True 'Inp0Button.cmdSuite.Enabled = True Inp0Button.cmdSuite.Enabled = False Inp0Button.cmdVariables.Enabled = True Inp0Button.cmdFormats.Enabled = True

End If

End Sub

'DISABLE MAIN BUTTONS ON FORM WHILE EDITING Sub disableButtons cmdClearAll.Enabled = False cmdSaveFile.Enabled = False cmdCloseForm.Enabled = False cmdComplete.Enabled = False 'cmdImport.Enabled = False End Sub

'ENABLE MAIN BUTTONS BACK ONCE EDITING IS DONE Sub enableButtons cmdClearAll.Enabled = True cmdSaveFile.Enabled = True cmdCloseForm.Enabled = True cmdComplete.Enabled = True 'cmdImport.Enabled = True End Sub

'GET SAME PERIOD FOR CSI/VDI AS THAT OF PSI Private Sub txtPSIBenchmarkPeriod_AfterUpdate If txtCSIBenchmarkPeriod.Text = "" Then txtCSIBenchmarkPeriod.Text = txtPSIBenchmarkPeriod.Text End If End Sub Private Sub txtPSICurrentPeriod_AfterUpdate If txtCSICurrentPeriod.Text = "" Then txtCSICurrentPeriod.Text = txtPSICurrentPeriod.Text End If End Sub

'GET SAME PERIOD FOR ALIGNMENT AS THAT OF STRENGTH Private Sub txtStrengthBenchmarkPeriod_AfterUpdate If txtAlignmentBenchmarkPeriod.Text = "" Then txtAlignmentBenchmarkPeriod.Text = txtStrengthBenchmarkPeriod.Text End If End Sub Private Sub txtStrengthCurrentPeriod_AfterUpdate If txtAlignmentCurrentPeriod.Text = "" Then txtAlignmentCurrentPeriod.Text = txtStrengthCurrentPeriod.Text End If End Sub

'CHECK IF VALUE ENTERED IS IN CORRECT RANGE OR NOT Private Sub txtBenchmarkKS_AfterUpdate Dim val As String val = txtBenchmarkKS.Text If Right(val, 1) = "%" Then val = Left(val, Len(val) - 1) / 100 End If   If val <> "" Then If IsNumeric(val) = False Then txtBenchmarkKS.Text = "" MsgBox "Please input numbers and . only!", vbOKOnly ElseIf (val > 1 Or val < 0) Then txtBenchmarkKS.Text = "" MsgBox "Please provide a number between 0 and 1", vbOKOnly + vbCritical End If   End If End Sub

Private Sub txtBenchmarkTrueKS_AfterUpdate Dim val As String val = txtBenchmarkTrueKS.Text If Right(val, 1) = "%" Then val = Left(val, Len(val) - 1) / 100 End If   If val <> "" Then If IsNumeric(val) = False Then txtBenchmarkTrueKS.Text = "" MsgBox "Please input numbers and . only!", vbOKOnly ElseIf (val > 1 Or val < 0) Then txtBenchmarkTrueKS.Text = "" MsgBox "Please provide a number between 0 and 1", vbOKOnly + vbCritical End If   End If End Sub

Private Sub txtBenchmarkGini_AfterUpdate Dim val As String val = txtBenchmarkGini.Text If Right(val, 1) = "%" Then val = Left(val, Len(val) - 1) / 100 End If   If val <> "" Then If IsNumeric(val) = False Then txtBenchmarkGini.Text = "" MsgBox "Please input numbers and . only!", vbOKOnly ElseIf (val > 1 Or val < 0) Then txtBenchmarkGini.Text = "" MsgBox "Please provide a number between 0 and 1", vbOKOnly + vbCritical End If   End If End Sub

Private Sub txtBenchmarkDivergence_AfterUpdate Dim val As String val = txtBenchmarkDivergence.Text If val <> "" Then If IsNumeric(val) = False Then txtBenchmarkDivergence.Text = "" MsgBox "Please input numbers and . only!", vbOKOnly End If   End If End Sub

Private Sub txtAverageGoodScore_AfterUpdate Dim val As String val = txtAverageGoodScore.Text If val <> "" Then If IsNumeric(val) = False Then txtAverageGoodScore.Text = "" MsgBox "Please input numbers and . only!", vbOKOnly End If   End If End Sub

Private Sub txtAverageBadScore_AfterUpdate Dim val As String val = txtAverageBadScore.Text If val <> "" Then If IsNumeric(val) = False Then txtAverageBadScore.Text = "" MsgBox "Please input numbers and . only!", vbOKOnly End If   End If End Sub

""" File:Example.jpg|Caption1 File:Example.jpg|Caption2 File:Example.jpg|Caption3 File:Example.jpg|Caption4 File:Example.jpg|Caption5