I am having an issue trying to figure out this debug error. I get Subscript is out of range when we add an entry into table for LOBName. We have a total of 101 entries right now. If we remove the last one it works but throws an error as soon as we add 101.
This line highlights yellow
ProviderID(NumProviders) = RS("ID").Value
Whole code:
Option Explicit
Private Const DataSetQuery As String = "SELECT DataSetName FROM " & DBSchema & ".DataSets ORDER BY ISNULL(Ordering,0)"
Public Sub InitializeStartForm()
Const TestDataSetQuery As String = "SELECT DataSetName FROM " & DBSchema & ".DataSets WHERE DataSetName like '%test%' ORDER BY ISNULL(Ordering,0)"
Const ShockSetQuery As String = "SELECT ShockSetName FROM " & DBSchema & ".ShockSets ORDER BY ISNULL(Ordering,50)"
Const SheetNamesQuery As String = "SELECT DISTINCT SheetName FROM " & DBSchema & ".ExposureTaxonomy ORDER BY SheetName"
Const ETStringKeysQuery As String = "SELECT StringKey FROM " & DBSchema & ".ExposureTaxonomy"
Const QAQueries As String = "SELECT ShortName FROM " & DBSchema & ".DataChecks ORDER BY Ordering"
Dim j As Integer
Dim ShockSetNames(100) As String
Dim DataSetNames(100) As String
Dim NumShockSetNames As Integer
Dim NumDataSetNames As Integer
Dim UsersGroup As String
Dim v As Variant
'---------------------------------------------------------------------------------------------------
'Some simple initialization
'---------------------------------------------------------------------------------------------------
NumCouldntUpload = 0
NumRecordsForUpload = 0
UploadCalledFromRibbon = False
'---------------------------------------------------------------------------------------------------
'Check to see if the user has DB access before doing anything so we can fail gracefully if not
'---------------------------------------------------------------------------------------------------
If Not UserHasSQLAccess Then
v = MsgBox("You do not appear to have access to the back end database." & vbNullString & vbNullString & _
"Please contact the databse administrator for assistance", vbCritical, "DB connection failure")
Exit Sub
End If
'---------------------------------------------------------------------------------------------------
'Pull some data which is used in multiple controls into arrays so we hit the DB less often
'---------------------------------------------------------------------------------------------------
Call FillArrayWithQueryResults(ShockSetNames, NumShockSetNames, ShockSetQuery)
Call FillArrayWithQueryResults(DataSetNames, NumDataSetNames, DataSetQuery)
With StartForm
.MultiPage1.Value = 0 'Start on the first tab
'------------------------------------------------------------
'Download Positions / P&L
'------------------------------------------------------------
'Populate the list of existing DataSetNames
Call FillComboBoxFromArray(DataSetNames, NumDataSetNames, .cbDataSetNamesDownload, True, , 0)
'Populate the ShockSetNames
Call FillComboBoxFromArray(ShockSetNames, NumShockSetNames, .cbShockSetNamesDownload, True, , 0)
'Populate the list of metrics, defaulting to 14Q data
.cbMetricDownload.Clear
.cbMetricDownload.AddItem ("14Q Data")
.cbMetricDownload.AddItem ("P&L Attribution")
.cbMetricDownload.AddItem ("14A Summary Data")
.cbMetricDownload.ListIndex = 0
'All checkboxes default to FALSE, so button should default to disabled
.btnDownload.Enabled = False
.btnPLDownload.Enabled = False
'----------------------------------------------------------------
'Set visibility/defaults based on user group where applicable
'----------------------------------------------------------------
'Pull user's group (GBAM, CIG, EST, etc) from Users table to set some defaults/visibility
UsersGroup = strResultForSQLQuery("SELECT ISNULL(MAX([Group]),'MISSING') FROM " & DBSchema & ".Users WHERE NBKID='" & NBKofUser & "'")
If UsersGroup = "MISSING" Then v = MsgBox("Current user (" & NBKofUser & ") needs to be added to the Users table." & vbNewLine & vbNewLine & _
"Available functionality may be limited", vbExclamation, "Unknown user")
'Default to GBAM blank template for GBAM users (download page)
.cbUseGBAMBlankTemplate.Value = (UsersGroup = "GBAM")
'Hide the ShockUploads pages for all users but EST
.MultiPage1.Pages("PgShockUploads").Visible = (UsersGroup = "EST")
'-----------------------------------------------------------------------------------------------
'Upload Positions
'-----------------------------------------------------------------------------------------------
'Populate the list of existing DataSetNames
Call FillComboBoxFromArray(DataSetNames, NumDataSetNames, .cbDataSetNames, True, , -1)
'Populate the list of existing LOB/Providers (note that if we do the Download Positions tab first, this info is in an array so no need to hit the DB)
.cbLOB.Clear
For j = 1 To NumProviders
.cbLOB.AddItem (ProviderName(j))
Next j
.cbLOB.ListIndex = -1
.btnPositionUpload.Enabled = False 'Only enable once a provider is selected
'-----------------------------------------------------------------------------------------------
'Upload P&L Attribution
'-----------------------------------------------------------------------------------------------
'Populate the list of existing DataSetNames
Call FillComboBoxFromArray(DataSetNames, NumDataSetNames, .cbULAttribDataSetNames, True, , -1)
'Populate the list of existing P&L Providers (which is different from the list of 14Q providers)
Call FillComboBoxWithQueryResults(.cbULAttribProvider, "SELECT ProviderName FROM " & DBSchema & ".PLProviders ORDER BY Ordering")
.btnAttributionUpload.Enabled = False 'Only enable once a provider is selected
'-----------------------------------------------------------------------------------------------
'Upload Fed Shocks
'-----------------------------------------------------------------------------------------------
'Populate the list of existing ShockSetNames
Call FillComboBoxFromArray(ShockSetNames, NumShockSetNames, .cbShockSetNames, True, , 1, "ADD NEW")
'And hide the label and text box about adding new
.lblNewShockSetName.Visible = False
.tbNewShockSetName.Visible = False
'-----------------------------------------------------------------------------------------------
'DataSet Mgmt
'-----------------------------------------------------------------------------------------------
'Defaults around adding a new DataSet
.tbNewDataSetName.Value = vbNullString
.cbCCARDataSet.Value = False
.btnCreateDataSet.Enabled = False 'Don't enable until a dataset name is entered
'DELETE SECTION (note that we only show DataSetNames which include the word "test" unless UsersGroup=EST)
If UsersGroup <> "EST" Then
Call FillComboBoxWithQueryResults(.cbDataSetNameDelete, TestDataSetQuery, True, , -1)
Else
Call FillComboBoxFromArray(DataSetNames, NumDataSetNames, .cbDataSetNameDelete, True, , -1)
End If
'And disable the 2 providers and their delete buttons until a DataSet is selected
.cb14QProviders.Enabled = False
.cbPLProviders.Enabled = False
.btnDelete14Q.Enabled = False
.btnDeletePL.Enabled = False
.btnDeleteAll.Enabled = False
'Renaming
.btnDSRename.Enabled = False
.tbDSRenamed.Text = vbNullString
Call FillComboBoxFromArray(DataSetNames, NumDataSetNames, .cbDSRename, True, , -1)
'-----------------------------------------------------------------------------------------------
'User Tools tab
'-----------------------------------------------------------------------------------------------
'QA SECTION
Call FillComboBoxFromArray(DataSetNames, NumDataSetNames, .cbDataSetNameFRBQA, True, , 0)
Call FillComboBoxWithQueryResults(.cbFRBQAQuery, QAQueries, True, , 0)
'EXPOSURE SOURCES SECTION
Call FillComboBoxFromArray(DataSetNames, NumDataSetNames, .cbDataSetNameExposureSources, True, , 0)
Call FillComboBoxWithQueryResults(.cbSheetName, SheetNamesQuery, True, , 0)
Call FillComboBoxWithQueryResults(.cbETNames, ETStringKeysQuery & " WHERE SheetName='" & .cbSheetName.Value & "' ORDER BY StringKey", True, , 0)
.Show
End With
End Sub
Public Sub ReadProvidersAndUpdateStartForm()
'Adds checkboxes for each provider to the Download Positions menu tab and selectively enables/disables them based on what's uploaded for that dataset
'Note that this is assuming that the ID's are sequential and start at 1 (i.e. MaxID=# of entries)
Const cbHeight As Integer = 16
Const cbWidth As Integer = 300
Const RowsPerColumn As Integer = 20
Dim strSQL As String
Dim RS As Recordset
Dim j As Integer
Dim k As Integer
Dim LOBPage As Integer
Dim MetricNumber As String
'This gets called by the onChange events for combo boxes for DataSet names and Metric selection, but we can
'skip if these combo boxes haven't been populated yet, so we only have to go through this code once
If StartForm.cbDataSetNamesDownload.ListCount = 0 Or StartForm.cbMetricDownload.ListCount = 0 Then Exit Sub
'Read off all the LOBID's that exist for this DataSetName
MetricNumber = StartForm.cbMetricDownload.ListIndex
Select Case MetricNumber
Case 1 'P&L Attribution
strSQL = ReadStringFromTextFile("ProviderList-Results Query.txt")
strSQL = Replace(strSQL, "XXX", StartForm.cbDataSetNamesDownload.Value)
strSQL = Replace(strSQL, "ZZZ", "(3)") 'ResultSourceID
Case 2 '14A Summary
strSQL = ReadStringFromTextFile("ProviderList-Results Query.txt")
strSQL = Replace(strSQL, "XXX", StartForm.cbDataSetNamesDownload.Value)
strSQL = Replace(strSQL, "ZZZ", "(2)") 'ResultSourceID
Case Else '14Q's as default
strSQL = ReadStringFromTextFile("ProviderList Query.txt")
strSQL = Replace(strSQL, "XXX", StartForm.cbDataSetNamesDownload.Value)
End Select
Dim cn As New ADODB.Connection
cn.Open DBConnectionString
Set RS = New ADODB.Recordset
With RS
.ActiveConnection = cn
.source = strSQL
.CursorType = adOpenForwardOnly
.LockType = adLockReadOnly
.CursorLocation = adUseServer
.Open
End With
'Step through all the records
NumProviders = 0
While Not RS.EOF
NumProviders = NumProviders + 1
ProviderID(NumProviders) = RS("ID").Value
ProviderName(NumProviders) = (RS("LOBName").Value)
ProviderOwnerGroup(NumProviders) = (RS("OwnerGroup").Value) 'GBAM, CIG or EST
ProviderEnabled(NumProviders) = (RS("RecordCount").Value > 0)
If RS("UserName").Value <> "NO DATA" Then
ProviderToolTip(NumProviders) = "Uploaded " & RS("TimeStamp").Value & " by " & RS("UserName").Value
Else
ProviderToolTip(NumProviders) = vbNullString
End If
ProviderSelected(NumProviders) = False
RS.MoveNext
Wend
RS.Close
cn.Close
Set RS = Nothing
Set cn = Nothing
Dim cb As MSForms.CheckBox
Dim aProviderCheckBox As ProviderCheckbox
Set ProviderCheckboxCollection = New VBA.Collection
With StartForm
.LOBMultipage.Pages(0).Controls.Clear
.LOBMultipage.Pages(1).Controls.Clear
.LOBMultipage.Pages(2).Controls.Clear
For j = 1 To NumProviders
If j > 80 Then
k = j - 80
LOBPage = 2
ElseIf j > 40 Then
k = j - 40
LOBPage = 1
Else
k = j
LOBPage = 0
End If
Set cb = .LOBMultipage.Pages(LOBPage).Controls.Add("Forms.Checkbox.1", "cbProvider" & Trim(CStr(j)), True)
With cb
.Left = 5 + cbWidth * Int((k - 1) / RowsPerColumn)
.Top = 5 + cbHeight * ((k - 1) Mod RowsPerColumn)
.Width = cbWidth
End With
Set aProviderCheckBox = New ProviderCheckbox 'Use the ProviderCheckBox class in order to stick on_click events on each checkbox
Set aProviderCheckBox.cBox = cb
aProviderCheckBox.SetUpForProvider (j) 'This class handles all the setup including captions, font, whether selected, etc.
ProviderCheckboxCollection.Add aProviderCheckBox 'Need to have a collection of these in order for them all to function properly
Next j
.LOBMultipage.Value = 0
.cbSelectPage.Value = False
.cbFICCEM.Value = False
.cbGCSS.Value = False
.cbGFF.Value = False
.cbGLOBALRATES.Value = False
'With all providers reset, none will be selected, so all buttons should be disabled
.btnDownload.Enabled = False
.btnPLDownload.Enabled = False
End With
Set cb = Nothing
Set aProviderCheckBox = Nothing
End Sub
Public Sub InitializeWSForm(Optional IgnoreDownloadMode As Boolean = False)
'Adds checkboxes for worksheet and selectively enables/disables them based on whether they are recognized
Const cbHeight As Integer = 18
Const cbWidth As Integer = 150
Const RowsPerColumn As Integer = 13
Dim cb As MSForms.CheckBox
Dim aWSCheckBox As WSCheckbox
Dim WS As Worksheet
Set WSCheckboxCollection = New VBA.Collection
NumWSwithUploadedData = 0
For NumWS = 1 To MaxNumWorkSheets
WSname(NumWS) = vbNullString
WSSelected(NumWS) = False
WSEnabled(NumWS) = False
WSWithUploadedData(NumWS) = vbNullString
Next NumWS
With WSform
'---------------------------------------------------------------------------------------------------
'Initialize and set file statistics section (differently depending on download mode)
'---------------------------------------------------------------------------------------------------
If DownloadMode And Not IgnoreDownloadMode Then
'Only enable worksheets for which data has been uploaded for this DataSetID/LOBID
Dim strSQL As String
strSQL = "SELECT DISTINCT SheetName FROM " & DBSchema & ".ExposureTaxonomy "
If SelectedDownloadField = "Aggregate" Then strSQL = strSQL & _
"ET INNER JOIN " & DBSchema & ".Positions P ON P.ETID=ET.ID WHERE DataSetID=" & DataSetID & " AND LOBID IN " & IncludeStringForProviders & vbNewLine & _
"UNION" & vbNewLine & _
"SELECT DISTINCT SheetName='IDR-Jump To Default' FROM " & DBSchema & ".IDRJTD WHERE DataSetID=" & DataSetID & " AND LOBID IN " & IncludeStringForProviders
Call FillArrayWithQueryResults(WSWithUploadedData, NumWSwithUploadedData, strSQL)
'And no need to show file statistics section
.FileStatsFrame.Visible = False
Else
'Set the file statistics labels
.FileStatsFrame.Visible = True
.lblFilename.Caption = "File name: " & OpenedWB.Name
.lblFileType.Caption = "File type: " & IIf(FileIsTradingTemplate, "14Q Exposures", "FRB Shock Template")
.lblDataSet.Caption = "DataSet: " & DataSetName
.lblProvider.Caption = "Provider: " & LOBNameForUpload
.lblEffectiveDate.Caption = "Effective Date: " & Format(EffectiveDate, "MM/DD/YYYY")
End If
'---------------------------------------------------------------------------------------------------
'Dynamically populate the worksheet names
'---------------------------------------------------------------------------------------------------
.WSFrame.Controls.Clear
.btnWS.Enabled = False 'Start with disabled. aWSCheckBox.SetUpForWSname will enable if any are set to selected.
NumWS = 0
For Each WS In OpenedWB.Worksheets
If UCase(Left(WS.Name, 4)) <> "MSTR" Then 'Don't bother adding MSTR sheets or else there will be a million to show
NumWS = NumWS + 1
WSname(NumWS) = UCase(Trim(WS.Name))
Set cb = .WSFrame.Controls.Add("Forms.Checkbox.1", "cbWS" & Trim(CStr(NumWS)), True)
With cb
.Left = 10 + cbWidth * Int((NumWS - 1) / RowsPerColumn)
.Top = 10 + cbHeight * ((NumWS - 1) Mod RowsPerColumn)
.Width = cbWidth
.Height = cbHeight
End With
Set aWSCheckBox = New WSCheckbox 'Use the WSCheckBox class in order to stick on_click events on each checkbox
Set aWSCheckBox.cBox = cb
aWSCheckBox.SetUpForWSname (WS.Name) 'This class handles all the setup including captions, font, whether selected, etc.
WSCheckboxCollection.Add aWSCheckBox 'Need to have a collection of these in order for them all to function properly
End If
Next
'---------------------------------------------------------------------------------------------------
'Set defualts for a few controls, show the form and end
'---------------------------------------------------------------------------------------------------
.CBSelectAll.Value = DownloadMode
.cbDeleteUnused.Value = DownloadMode
.cbDeleteUnused.Visible = DownloadMode
.cbDisaggregate.Value = False
.cbDisaggregate.Visible = DownloadMode
DeleteUnusedSheets = DownloadMode
.Show
End With
Set cb = Nothing
Set aWSCheckBox = Nothing
End Sub
Public Function IncludeStringForProviders() As String
Dim Result As String
Dim j As Integer
Result = "("
For j = 1 To NumProviders
If ProviderSelected(j) Then Result = Result & CStr(ProviderID(j)) & ","
Next j
If Right(Result, 1) = "," Then Result = Left(Result, Len(Result) - 1)
IncludeStringForProviders = Result & ")"
End Function
Public Function NamesofAllSelectedProviders() As String
Dim Result As String
Dim j As Integer
Result = vbNullString
For j = 1 To NumProviders
If ProviderSelected(j) Then Result = Result & ProviderName(j) & "+"
Next j
If Right(Result, 1) = "+" Then Result = Left(Result, Len(Result) - 1)
NamesofAllSelectedProviders = Result
End Function
Public Function WSNameHasUploadedData(aWSName As String)
Dim j As Integer
For j = 1 To NumWSwithUploadedData
If WSWithUploadedData(j) = aWSName Then
WSNameHasUploadedData = True
Exit Function
End If
Next j
WSNameHasUploadedData = False
End Function
Public Sub InitializeUploadCurrent()
Dim v As Variant
Dim InvalidFileDetails As String
Dim ComponentName As String
'---------------------------------------------------------------------------------------
'Need to do some pre-checking before we decide whether or not to even launch the form!
'---------------------------------------------------------------------------------------
'First make sure something is open to upload
If Application.Workbooks.Count = 0 Then
v = MsgBox("This function requires an open Trading 14Q file!", vbExclamation, "Functionality not available")
Exit Sub
End If
'Make sure what is open is a valid Trading 14Q. Note that this call returns the Component name and any needed error message detail
If Not ActiveWorkbookIsUploadable14Q(InvalidFileDetails, ComponentName) Then
v = MsgBox("The active workbook is not a valid Trading 14Q file!" & vbNewLine & vbNewLine & _
InvalidFileDetails, vbCritical, "Functionality not available")
Exit Sub
End If
'---------------------------------------------------------------------------------------------------
'Check to see if the user has DB access before doing anything so we can fail gracefully if not
'---------------------------------------------------------------------------------------------------
If Not UserHasSQLAccess Then
v = MsgBox("You do not appear to have access to the back end database." & vbNullString & vbNullString & _
"Please contact the databse administrator for assistance", vbCritical, "DB connection failure")
Exit Sub
End If
'If we are still here, then prepare the form and show it
With UploadCurrentForm
'Populate the list of existing DataSetNames
Call FillComboBoxWithQueryResults(.cbUCDataSetNames, DataSetQuery, True)
.btnUploadCurrent.Enabled = False 'Don't enable the button until a DataSet is chosen
.lblCurrentProvider.Caption = ComponentName
.Show
End With
End Sub
Public Function ActiveWorkbookHasValidLOB(ByRef strReturnMessage As String, ByRef ComponentName As String, _
Optional UsePLProviders As Boolean = False) As Boolean
'Checks for a cover sheet with a Provider cell that has a valid entry. Do we care to check other worksheet names?
Dim v As Variant
On Error GoTo FileBad
'Check if there is a sheet called Cover Sheet
strReturnMessage = "Cover sheet not found."
v = ActiveWorkbook.Worksheets("Cover Sheet").Range("A1").Value
'Check if there is a global range called Component
strReturnMessage = "Named range 'Component' not found."
v = Range("Component").Value
ComponentName = CStr(v)
'Check if there is a range called EffectiveDate on the Cover Sheet
strReturnMessage = "Named range 'EffectiveDate' not found on cover sheet."
v = Worksheets("Cover Sheet").Range("EffectiveDate").Value
'Finally, check if the component name is valid
strReturnMessage = "Component name: " & ComponentName & " is not valid."
If UsePLProviders Then
If LongResultForSQLQuery("SELECT COUNT(*) FROM " & DBSchema & ".PLProviders WHERE ProviderName='" & ComponentName & "'") = 0 Then GoTo FileBad
Else
If LongResultForSQLQuery("SELECT COUNT(*) FROM " & DBSchema & ".LOB WHERE LOBName='" & ComponentName & "'") = 0 Then GoTo FileBad
End If
'Otherwise no issues
strReturnMessage = vbNullString
ActiveWorkbookHasValidLOB = True
Exit Function
FileBad:
ActiveWorkbookHasValidLOB = False
End Function
Public Function ActiveWorkbookIsValidTemplate(strTemplateName As String, ByRef strReturnMessage As String, ByRef ComponentName As String, _
Optional UsePLProviders As Boolean = False) As Boolean
On Error GoTo FileBad
If Not ActiveWorkbookHasValidLOB(strReturnMessage, ComponentName, UsePLProviders) Then GoTo FileBad
'Also check the template name
Dim v As Variant
v = ActiveWorkbook.Worksheets("Cover Sheet").Range("B2").Value 'Note that we have already validated that there is a cover sheet, so this shouldn't fail
If CStr(v) <> strTemplateName Then
Sheets("Cover Sheet").Select
Range("B2").Select
strReturnMessage = "Template name '" & CStr(v) & "' in cell B2 is not recognized." & vbNewLine & vbNewLine & _
"Expected template name is '" & strTemplateName & "'."
GoTo FileBad
End If
'Otherwise no issues
strReturnMessage = vbNullString
ActiveWorkbookIsValidTemplate = True
Exit Function
FileBad:
ActiveWorkbookIsValidTemplate = False
End Function
Public Function ActiveWorkbookIsUploadable14Q(ByRef strReturnMessage As String, ByRef ComponentName As String) As Boolean
ActiveWorkbookIsUploadable14Q = ActiveWorkbookIsValidTemplate("Trading, PE & Other Fair Value Assets Schedule", strReturnMessage, ComponentName)
End Function
Any help would be greatly appreciated. Thank you in advance.
This line highlights yellow
ProviderID(NumProviders) = RS("ID").Value
Whole code:
Option Explicit
Private Const DataSetQuery As String = "SELECT DataSetName FROM " & DBSchema & ".DataSets ORDER BY ISNULL(Ordering,0)"
Public Sub InitializeStartForm()
Const TestDataSetQuery As String = "SELECT DataSetName FROM " & DBSchema & ".DataSets WHERE DataSetName like '%test%' ORDER BY ISNULL(Ordering,0)"
Const ShockSetQuery As String = "SELECT ShockSetName FROM " & DBSchema & ".ShockSets ORDER BY ISNULL(Ordering,50)"
Const SheetNamesQuery As String = "SELECT DISTINCT SheetName FROM " & DBSchema & ".ExposureTaxonomy ORDER BY SheetName"
Const ETStringKeysQuery As String = "SELECT StringKey FROM " & DBSchema & ".ExposureTaxonomy"
Const QAQueries As String = "SELECT ShortName FROM " & DBSchema & ".DataChecks ORDER BY Ordering"
Dim j As Integer
Dim ShockSetNames(100) As String
Dim DataSetNames(100) As String
Dim NumShockSetNames As Integer
Dim NumDataSetNames As Integer
Dim UsersGroup As String
Dim v As Variant
'---------------------------------------------------------------------------------------------------
'Some simple initialization
'---------------------------------------------------------------------------------------------------
NumCouldntUpload = 0
NumRecordsForUpload = 0
UploadCalledFromRibbon = False
'---------------------------------------------------------------------------------------------------
'Check to see if the user has DB access before doing anything so we can fail gracefully if not
'---------------------------------------------------------------------------------------------------
If Not UserHasSQLAccess Then
v = MsgBox("You do not appear to have access to the back end database." & vbNullString & vbNullString & _
"Please contact the databse administrator for assistance", vbCritical, "DB connection failure")
Exit Sub
End If
'---------------------------------------------------------------------------------------------------
'Pull some data which is used in multiple controls into arrays so we hit the DB less often
'---------------------------------------------------------------------------------------------------
Call FillArrayWithQueryResults(ShockSetNames, NumShockSetNames, ShockSetQuery)
Call FillArrayWithQueryResults(DataSetNames, NumDataSetNames, DataSetQuery)
With StartForm
.MultiPage1.Value = 0 'Start on the first tab
'------------------------------------------------------------
'Download Positions / P&L
'------------------------------------------------------------
'Populate the list of existing DataSetNames
Call FillComboBoxFromArray(DataSetNames, NumDataSetNames, .cbDataSetNamesDownload, True, , 0)
'Populate the ShockSetNames
Call FillComboBoxFromArray(ShockSetNames, NumShockSetNames, .cbShockSetNamesDownload, True, , 0)
'Populate the list of metrics, defaulting to 14Q data
.cbMetricDownload.Clear
.cbMetricDownload.AddItem ("14Q Data")
.cbMetricDownload.AddItem ("P&L Attribution")
.cbMetricDownload.AddItem ("14A Summary Data")
.cbMetricDownload.ListIndex = 0
'All checkboxes default to FALSE, so button should default to disabled
.btnDownload.Enabled = False
.btnPLDownload.Enabled = False
'----------------------------------------------------------------
'Set visibility/defaults based on user group where applicable
'----------------------------------------------------------------
'Pull user's group (GBAM, CIG, EST, etc) from Users table to set some defaults/visibility
UsersGroup = strResultForSQLQuery("SELECT ISNULL(MAX([Group]),'MISSING') FROM " & DBSchema & ".Users WHERE NBKID='" & NBKofUser & "'")
If UsersGroup = "MISSING" Then v = MsgBox("Current user (" & NBKofUser & ") needs to be added to the Users table." & vbNewLine & vbNewLine & _
"Available functionality may be limited", vbExclamation, "Unknown user")
'Default to GBAM blank template for GBAM users (download page)
.cbUseGBAMBlankTemplate.Value = (UsersGroup = "GBAM")
'Hide the ShockUploads pages for all users but EST
.MultiPage1.Pages("PgShockUploads").Visible = (UsersGroup = "EST")
'-----------------------------------------------------------------------------------------------
'Upload Positions
'-----------------------------------------------------------------------------------------------
'Populate the list of existing DataSetNames
Call FillComboBoxFromArray(DataSetNames, NumDataSetNames, .cbDataSetNames, True, , -1)
'Populate the list of existing LOB/Providers (note that if we do the Download Positions tab first, this info is in an array so no need to hit the DB)
.cbLOB.Clear
For j = 1 To NumProviders
.cbLOB.AddItem (ProviderName(j))
Next j
.cbLOB.ListIndex = -1
.btnPositionUpload.Enabled = False 'Only enable once a provider is selected
'-----------------------------------------------------------------------------------------------
'Upload P&L Attribution
'-----------------------------------------------------------------------------------------------
'Populate the list of existing DataSetNames
Call FillComboBoxFromArray(DataSetNames, NumDataSetNames, .cbULAttribDataSetNames, True, , -1)
'Populate the list of existing P&L Providers (which is different from the list of 14Q providers)
Call FillComboBoxWithQueryResults(.cbULAttribProvider, "SELECT ProviderName FROM " & DBSchema & ".PLProviders ORDER BY Ordering")
.btnAttributionUpload.Enabled = False 'Only enable once a provider is selected
'-----------------------------------------------------------------------------------------------
'Upload Fed Shocks
'-----------------------------------------------------------------------------------------------
'Populate the list of existing ShockSetNames
Call FillComboBoxFromArray(ShockSetNames, NumShockSetNames, .cbShockSetNames, True, , 1, "ADD NEW")
'And hide the label and text box about adding new
.lblNewShockSetName.Visible = False
.tbNewShockSetName.Visible = False
'-----------------------------------------------------------------------------------------------
'DataSet Mgmt
'-----------------------------------------------------------------------------------------------
'Defaults around adding a new DataSet
.tbNewDataSetName.Value = vbNullString
.cbCCARDataSet.Value = False
.btnCreateDataSet.Enabled = False 'Don't enable until a dataset name is entered
'DELETE SECTION (note that we only show DataSetNames which include the word "test" unless UsersGroup=EST)
If UsersGroup <> "EST" Then
Call FillComboBoxWithQueryResults(.cbDataSetNameDelete, TestDataSetQuery, True, , -1)
Else
Call FillComboBoxFromArray(DataSetNames, NumDataSetNames, .cbDataSetNameDelete, True, , -1)
End If
'And disable the 2 providers and their delete buttons until a DataSet is selected
.cb14QProviders.Enabled = False
.cbPLProviders.Enabled = False
.btnDelete14Q.Enabled = False
.btnDeletePL.Enabled = False
.btnDeleteAll.Enabled = False
'Renaming
.btnDSRename.Enabled = False
.tbDSRenamed.Text = vbNullString
Call FillComboBoxFromArray(DataSetNames, NumDataSetNames, .cbDSRename, True, , -1)
'-----------------------------------------------------------------------------------------------
'User Tools tab
'-----------------------------------------------------------------------------------------------
'QA SECTION
Call FillComboBoxFromArray(DataSetNames, NumDataSetNames, .cbDataSetNameFRBQA, True, , 0)
Call FillComboBoxWithQueryResults(.cbFRBQAQuery, QAQueries, True, , 0)
'EXPOSURE SOURCES SECTION
Call FillComboBoxFromArray(DataSetNames, NumDataSetNames, .cbDataSetNameExposureSources, True, , 0)
Call FillComboBoxWithQueryResults(.cbSheetName, SheetNamesQuery, True, , 0)
Call FillComboBoxWithQueryResults(.cbETNames, ETStringKeysQuery & " WHERE SheetName='" & .cbSheetName.Value & "' ORDER BY StringKey", True, , 0)
.Show
End With
End Sub
Public Sub ReadProvidersAndUpdateStartForm()
'Adds checkboxes for each provider to the Download Positions menu tab and selectively enables/disables them based on what's uploaded for that dataset
'Note that this is assuming that the ID's are sequential and start at 1 (i.e. MaxID=# of entries)
Const cbHeight As Integer = 16
Const cbWidth As Integer = 300
Const RowsPerColumn As Integer = 20
Dim strSQL As String
Dim RS As Recordset
Dim j As Integer
Dim k As Integer
Dim LOBPage As Integer
Dim MetricNumber As String
'This gets called by the onChange events for combo boxes for DataSet names and Metric selection, but we can
'skip if these combo boxes haven't been populated yet, so we only have to go through this code once
If StartForm.cbDataSetNamesDownload.ListCount = 0 Or StartForm.cbMetricDownload.ListCount = 0 Then Exit Sub
'Read off all the LOBID's that exist for this DataSetName
MetricNumber = StartForm.cbMetricDownload.ListIndex
Select Case MetricNumber
Case 1 'P&L Attribution
strSQL = ReadStringFromTextFile("ProviderList-Results Query.txt")
strSQL = Replace(strSQL, "XXX", StartForm.cbDataSetNamesDownload.Value)
strSQL = Replace(strSQL, "ZZZ", "(3)") 'ResultSourceID
Case 2 '14A Summary
strSQL = ReadStringFromTextFile("ProviderList-Results Query.txt")
strSQL = Replace(strSQL, "XXX", StartForm.cbDataSetNamesDownload.Value)
strSQL = Replace(strSQL, "ZZZ", "(2)") 'ResultSourceID
Case Else '14Q's as default
strSQL = ReadStringFromTextFile("ProviderList Query.txt")
strSQL = Replace(strSQL, "XXX", StartForm.cbDataSetNamesDownload.Value)
End Select
Dim cn As New ADODB.Connection
cn.Open DBConnectionString
Set RS = New ADODB.Recordset
With RS
.ActiveConnection = cn
.source = strSQL
.CursorType = adOpenForwardOnly
.LockType = adLockReadOnly
.CursorLocation = adUseServer
.Open
End With
'Step through all the records
NumProviders = 0
While Not RS.EOF
NumProviders = NumProviders + 1
ProviderID(NumProviders) = RS("ID").Value
ProviderName(NumProviders) = (RS("LOBName").Value)
ProviderOwnerGroup(NumProviders) = (RS("OwnerGroup").Value) 'GBAM, CIG or EST
ProviderEnabled(NumProviders) = (RS("RecordCount").Value > 0)
If RS("UserName").Value <> "NO DATA" Then
ProviderToolTip(NumProviders) = "Uploaded " & RS("TimeStamp").Value & " by " & RS("UserName").Value
Else
ProviderToolTip(NumProviders) = vbNullString
End If
ProviderSelected(NumProviders) = False
RS.MoveNext
Wend
RS.Close
cn.Close
Set RS = Nothing
Set cn = Nothing
Dim cb As MSForms.CheckBox
Dim aProviderCheckBox As ProviderCheckbox
Set ProviderCheckboxCollection = New VBA.Collection
With StartForm
.LOBMultipage.Pages(0).Controls.Clear
.LOBMultipage.Pages(1).Controls.Clear
.LOBMultipage.Pages(2).Controls.Clear
For j = 1 To NumProviders
If j > 80 Then
k = j - 80
LOBPage = 2
ElseIf j > 40 Then
k = j - 40
LOBPage = 1
Else
k = j
LOBPage = 0
End If
Set cb = .LOBMultipage.Pages(LOBPage).Controls.Add("Forms.Checkbox.1", "cbProvider" & Trim(CStr(j)), True)
With cb
.Left = 5 + cbWidth * Int((k - 1) / RowsPerColumn)
.Top = 5 + cbHeight * ((k - 1) Mod RowsPerColumn)
.Width = cbWidth
End With
Set aProviderCheckBox = New ProviderCheckbox 'Use the ProviderCheckBox class in order to stick on_click events on each checkbox
Set aProviderCheckBox.cBox = cb
aProviderCheckBox.SetUpForProvider (j) 'This class handles all the setup including captions, font, whether selected, etc.
ProviderCheckboxCollection.Add aProviderCheckBox 'Need to have a collection of these in order for them all to function properly
Next j
.LOBMultipage.Value = 0
.cbSelectPage.Value = False
.cbFICCEM.Value = False
.cbGCSS.Value = False
.cbGFF.Value = False
.cbGLOBALRATES.Value = False
'With all providers reset, none will be selected, so all buttons should be disabled
.btnDownload.Enabled = False
.btnPLDownload.Enabled = False
End With
Set cb = Nothing
Set aProviderCheckBox = Nothing
End Sub
Public Sub InitializeWSForm(Optional IgnoreDownloadMode As Boolean = False)
'Adds checkboxes for worksheet and selectively enables/disables them based on whether they are recognized
Const cbHeight As Integer = 18
Const cbWidth As Integer = 150
Const RowsPerColumn As Integer = 13
Dim cb As MSForms.CheckBox
Dim aWSCheckBox As WSCheckbox
Dim WS As Worksheet
Set WSCheckboxCollection = New VBA.Collection
NumWSwithUploadedData = 0
For NumWS = 1 To MaxNumWorkSheets
WSname(NumWS) = vbNullString
WSSelected(NumWS) = False
WSEnabled(NumWS) = False
WSWithUploadedData(NumWS) = vbNullString
Next NumWS
With WSform
'---------------------------------------------------------------------------------------------------
'Initialize and set file statistics section (differently depending on download mode)
'---------------------------------------------------------------------------------------------------
If DownloadMode And Not IgnoreDownloadMode Then
'Only enable worksheets for which data has been uploaded for this DataSetID/LOBID
Dim strSQL As String
strSQL = "SELECT DISTINCT SheetName FROM " & DBSchema & ".ExposureTaxonomy "
If SelectedDownloadField = "Aggregate" Then strSQL = strSQL & _
"ET INNER JOIN " & DBSchema & ".Positions P ON P.ETID=ET.ID WHERE DataSetID=" & DataSetID & " AND LOBID IN " & IncludeStringForProviders & vbNewLine & _
"UNION" & vbNewLine & _
"SELECT DISTINCT SheetName='IDR-Jump To Default' FROM " & DBSchema & ".IDRJTD WHERE DataSetID=" & DataSetID & " AND LOBID IN " & IncludeStringForProviders
Call FillArrayWithQueryResults(WSWithUploadedData, NumWSwithUploadedData, strSQL)
'And no need to show file statistics section
.FileStatsFrame.Visible = False
Else
'Set the file statistics labels
.FileStatsFrame.Visible = True
.lblFilename.Caption = "File name: " & OpenedWB.Name
.lblFileType.Caption = "File type: " & IIf(FileIsTradingTemplate, "14Q Exposures", "FRB Shock Template")
.lblDataSet.Caption = "DataSet: " & DataSetName
.lblProvider.Caption = "Provider: " & LOBNameForUpload
.lblEffectiveDate.Caption = "Effective Date: " & Format(EffectiveDate, "MM/DD/YYYY")
End If
'---------------------------------------------------------------------------------------------------
'Dynamically populate the worksheet names
'---------------------------------------------------------------------------------------------------
.WSFrame.Controls.Clear
.btnWS.Enabled = False 'Start with disabled. aWSCheckBox.SetUpForWSname will enable if any are set to selected.
NumWS = 0
For Each WS In OpenedWB.Worksheets
If UCase(Left(WS.Name, 4)) <> "MSTR" Then 'Don't bother adding MSTR sheets or else there will be a million to show
NumWS = NumWS + 1
WSname(NumWS) = UCase(Trim(WS.Name))
Set cb = .WSFrame.Controls.Add("Forms.Checkbox.1", "cbWS" & Trim(CStr(NumWS)), True)
With cb
.Left = 10 + cbWidth * Int((NumWS - 1) / RowsPerColumn)
.Top = 10 + cbHeight * ((NumWS - 1) Mod RowsPerColumn)
.Width = cbWidth
.Height = cbHeight
End With
Set aWSCheckBox = New WSCheckbox 'Use the WSCheckBox class in order to stick on_click events on each checkbox
Set aWSCheckBox.cBox = cb
aWSCheckBox.SetUpForWSname (WS.Name) 'This class handles all the setup including captions, font, whether selected, etc.
WSCheckboxCollection.Add aWSCheckBox 'Need to have a collection of these in order for them all to function properly
End If
Next
'---------------------------------------------------------------------------------------------------
'Set defualts for a few controls, show the form and end
'---------------------------------------------------------------------------------------------------
.CBSelectAll.Value = DownloadMode
.cbDeleteUnused.Value = DownloadMode
.cbDeleteUnused.Visible = DownloadMode
.cbDisaggregate.Value = False
.cbDisaggregate.Visible = DownloadMode
DeleteUnusedSheets = DownloadMode
.Show
End With
Set cb = Nothing
Set aWSCheckBox = Nothing
End Sub
Public Function IncludeStringForProviders() As String
Dim Result As String
Dim j As Integer
Result = "("
For j = 1 To NumProviders
If ProviderSelected(j) Then Result = Result & CStr(ProviderID(j)) & ","
Next j
If Right(Result, 1) = "," Then Result = Left(Result, Len(Result) - 1)
IncludeStringForProviders = Result & ")"
End Function
Public Function NamesofAllSelectedProviders() As String
Dim Result As String
Dim j As Integer
Result = vbNullString
For j = 1 To NumProviders
If ProviderSelected(j) Then Result = Result & ProviderName(j) & "+"
Next j
If Right(Result, 1) = "+" Then Result = Left(Result, Len(Result) - 1)
NamesofAllSelectedProviders = Result
End Function
Public Function WSNameHasUploadedData(aWSName As String)
Dim j As Integer
For j = 1 To NumWSwithUploadedData
If WSWithUploadedData(j) = aWSName Then
WSNameHasUploadedData = True
Exit Function
End If
Next j
WSNameHasUploadedData = False
End Function
Public Sub InitializeUploadCurrent()
Dim v As Variant
Dim InvalidFileDetails As String
Dim ComponentName As String
'---------------------------------------------------------------------------------------
'Need to do some pre-checking before we decide whether or not to even launch the form!
'---------------------------------------------------------------------------------------
'First make sure something is open to upload
If Application.Workbooks.Count = 0 Then
v = MsgBox("This function requires an open Trading 14Q file!", vbExclamation, "Functionality not available")
Exit Sub
End If
'Make sure what is open is a valid Trading 14Q. Note that this call returns the Component name and any needed error message detail
If Not ActiveWorkbookIsUploadable14Q(InvalidFileDetails, ComponentName) Then
v = MsgBox("The active workbook is not a valid Trading 14Q file!" & vbNewLine & vbNewLine & _
InvalidFileDetails, vbCritical, "Functionality not available")
Exit Sub
End If
'---------------------------------------------------------------------------------------------------
'Check to see if the user has DB access before doing anything so we can fail gracefully if not
'---------------------------------------------------------------------------------------------------
If Not UserHasSQLAccess Then
v = MsgBox("You do not appear to have access to the back end database." & vbNullString & vbNullString & _
"Please contact the databse administrator for assistance", vbCritical, "DB connection failure")
Exit Sub
End If
'If we are still here, then prepare the form and show it
With UploadCurrentForm
'Populate the list of existing DataSetNames
Call FillComboBoxWithQueryResults(.cbUCDataSetNames, DataSetQuery, True)
.btnUploadCurrent.Enabled = False 'Don't enable the button until a DataSet is chosen
.lblCurrentProvider.Caption = ComponentName
.Show
End With
End Sub
Public Function ActiveWorkbookHasValidLOB(ByRef strReturnMessage As String, ByRef ComponentName As String, _
Optional UsePLProviders As Boolean = False) As Boolean
'Checks for a cover sheet with a Provider cell that has a valid entry. Do we care to check other worksheet names?
Dim v As Variant
On Error GoTo FileBad
'Check if there is a sheet called Cover Sheet
strReturnMessage = "Cover sheet not found."
v = ActiveWorkbook.Worksheets("Cover Sheet").Range("A1").Value
'Check if there is a global range called Component
strReturnMessage = "Named range 'Component' not found."
v = Range("Component").Value
ComponentName = CStr(v)
'Check if there is a range called EffectiveDate on the Cover Sheet
strReturnMessage = "Named range 'EffectiveDate' not found on cover sheet."
v = Worksheets("Cover Sheet").Range("EffectiveDate").Value
'Finally, check if the component name is valid
strReturnMessage = "Component name: " & ComponentName & " is not valid."
If UsePLProviders Then
If LongResultForSQLQuery("SELECT COUNT(*) FROM " & DBSchema & ".PLProviders WHERE ProviderName='" & ComponentName & "'") = 0 Then GoTo FileBad
Else
If LongResultForSQLQuery("SELECT COUNT(*) FROM " & DBSchema & ".LOB WHERE LOBName='" & ComponentName & "'") = 0 Then GoTo FileBad
End If
'Otherwise no issues
strReturnMessage = vbNullString
ActiveWorkbookHasValidLOB = True
Exit Function
FileBad:
ActiveWorkbookHasValidLOB = False
End Function
Public Function ActiveWorkbookIsValidTemplate(strTemplateName As String, ByRef strReturnMessage As String, ByRef ComponentName As String, _
Optional UsePLProviders As Boolean = False) As Boolean
On Error GoTo FileBad
If Not ActiveWorkbookHasValidLOB(strReturnMessage, ComponentName, UsePLProviders) Then GoTo FileBad
'Also check the template name
Dim v As Variant
v = ActiveWorkbook.Worksheets("Cover Sheet").Range("B2").Value 'Note that we have already validated that there is a cover sheet, so this shouldn't fail
If CStr(v) <> strTemplateName Then
Sheets("Cover Sheet").Select
Range("B2").Select
strReturnMessage = "Template name '" & CStr(v) & "' in cell B2 is not recognized." & vbNewLine & vbNewLine & _
"Expected template name is '" & strTemplateName & "'."
GoTo FileBad
End If
'Otherwise no issues
strReturnMessage = vbNullString
ActiveWorkbookIsValidTemplate = True
Exit Function
FileBad:
ActiveWorkbookIsValidTemplate = False
End Function
Public Function ActiveWorkbookIsUploadable14Q(ByRef strReturnMessage As String, ByRef ComponentName As String) As Boolean
ActiveWorkbookIsUploadable14Q = ActiveWorkbookIsValidTemplate("Trading, PE & Other Fair Value Assets Schedule", strReturnMessage, ComponentName)
End Function
Any help would be greatly appreciated. Thank you in advance.
