Previously when running my code in 2010 excel version (Version 14.0.7165.5000), it runs in 4 minutes. (however if I run it a second time, it doesnt work)
When switching to 2013 I get 'excel not responding' or it just excel hangs.
The code opens a files from a directory, loads them into my excel sheet and compiles and transforms some data.
Does anyone know why this is? Is there some function I am using that works in 2010 but not in 2013? I have included the code below.
which calls:
Other included calls:
1)
2)
When switching to 2013 I get 'excel not responding' or it just excel hangs.
The code opens a files from a directory, loads them into my excel sheet and compiles and transforms some data.
Does anyone know why this is? Is there some function I am using that works in 2010 but not in 2013? I have included the code below.
Code:
Public Sub calculateIRStressScenarioShock_wrapper()
OptimizeVBA True
Dim i As Long, count As Long, nCols As Long
Dim keepcols() As Long
Dim exportPath As String
Dim discountCurveNames() As Variant
ReDim keepcols(1 To 1) As Long: keepcols(1) = 1
discountCurveNames = colsFromWStoArr(Sheets("Discount_Curves"), keepcols, False)
discountCurveNames = distinctArrCol(discountCurveNames, 1, True) 'in case there are duplicate entries
'generate list of scenario file names
Dim filepath As String
filepath = get_this_data("Tables", "B", "scenarioDef_folder", "C")
Dim file As Variant
file = Dir(filepath)
While (file <> "")
count = count + 1
file = Dir
Wend
Dim scenNames() As Variant
ReDim scenNames(1 To count, 1)
file = Dir(filepath)
i = 1
While (file <> "")
scenNames(i, 1) = leftOfLastChar(CStr(file), ".")
file = Dir
i = i + 1
Wend
'get export filepath
exportPath = ""
'read in curve names to market data curve name mapping
Dim curveNameToMarketData() As Variant
ReDim keepcols(1 To 2)
keepcols(1) = getWScolNum("Stress Scenario Definition Curve Name", Sheets("mappings"))
keepcols(2) = getWScolNum("Market Data Curve Name", Sheets("mappings"))
curveNameToMarketData = colsFromWStoArr(Worksheets("mappings"), keepcols, False)
Call quicksort(curveNameToMarketData, 1, 1, UBound(curveNameToMarketData, 1))
'load curve market data into array
Dim riskDate As Date
riskDate = Sheets("Start").Range("d2").Value
Dim curveDataWS As Worksheet
Dim curveDataPath As String
Dim lastrow As Long
Set curveDataWS = ActiveWorkbook.Worksheets("CurveMktData_IR")
lastrow = lastWSrow(curveDataWS)
'read into array
Dim curveData() As Variant
nCols = lastWScol(curveDataWS)
ReDim keepcols(1 To nCols)
For i = 1 To nCols
keepcols(i) = i
Next i
curveData = colsFromWStoArr(curveDataWS, keepcols, True)
'filter array
curveData = filterIn(curveData, 1, riskDate, keepcols)
'*********************************************************************************************************************
'check whether curve names to market data curve name mapping is incomplete, if yes, output the missing curve names
Dim thisCurveMapRow As Long
Dim errorFound As Boolean
Dim thisCurve As Long
errorFound = False
Dim errorStr As String
errorStr = ""
For thisCurve = 1 To UBound(discountCurveNames, 1)
thisCurveMapRow = findInArrCol(discountCurveNames(thisCurve, 1), 1, curveNameToMarketData)
If thisCurveMapRow = 0 Then
errorFound = True
errorStr = errorStr & discountCurveNames(thisCurve, 1) & Chr(10)
End If
Next thisCurve
'write error message
If errorFound Then
MsgBox "Could not map the following items. Please add those curves into the CurveNameMapping tab." & Chr(10) & errorStr
Exit Sub
Else
'Worksheets("instructions").Range("instructions_mappingError").Value = "No errors"
End If
'*********************************************************************************************************************
'term buckets
Dim termBuckets(1 To 15) As Variant
termBuckets(1) = 0
termBuckets(2) = 30
termBuckets(3) = 91
termBuckets(4) = 182
termBuckets(5) = 365
termBuckets(6) = 730
termBuckets(7) = 1095
termBuckets(8) = 1461
termBuckets(9) = 1826
termBuckets(10) = 2556
termBuckets(11) = 3652
termBuckets(12) = 5478
termBuckets(13) = 7305
termBuckets(14) = 10957
termBuckets(15) = 21914
'risk free currency to curve mapping
Dim currToRiskFree() As Variant
ReDim keepcols(1 To 2)
keepcols(1) = getWScolNum("Currency", Sheets("mappings"))
keepcols(2) = getWScolNum("Risk free curve", Sheets("mappings"))
currToRiskFree = colsFromWStoArr(Worksheets("mappings"), keepcols, False)
'generate shocks
Call generateIRandCRshocks(filepath, scenNames, curveNameToMarketData, curveData, discountCurveNames, currToRiskFree, termBuckets, exportPath)
OptimizeVBA False
End Subwhich calls:
Code:
Public Sub generateIRandCRshocks(scenPath As String, scenNames() As Variant, curveNameToMarketData() As Variant, curveData() As Variant, curveNames() As Variant, currToRiskFree() As Variant, termBuckets() As Variant, exportPath As String)
Dim i As Long, j As Long
Dim thisScen As Long, thisCurve As Long, thisBucket As Long
Dim lastrow As Long, thisRow As Long
Dim thisArr() As Variant
Dim thisArrRow As Long, thisCurveMapRow As Long, thisCurveDataRow As Long, thisRiskFreeRow As Long
Dim sourceWB As Workbook
Dim sourceWS As Worksheet
'ensure data to be searched is sorted
Call quicksort(curveData, 2, 1, UBound(curveData, 1))
Call quicksort(curveNameToMarketData, 1, 1, UBound(curveNameToMarketData, 1))
'create data structure to hold shocks
Dim arrshocks() As Variant
ReDim arrshocks(1 To UBound(scenNames) * UBound(curveNames) * 2, 1 To 3 + UBound(termBuckets))
'list column names to be read in ***code assumes all files have the same format!
Dim readcols() As Variant
ReDim readcols(1 To 9)
readcols(1) = 1 'RF attribute1
readcols(2) = 2 'RF attribute2
readcols(3) = 3 'RF attribute3
readcols(4) = 4 'RF attribute4
readcols(5) = 5 'RF attribute5
readcols(6) = 6 'RF attribute6
readcols(7) = 7 'RF attribute7
readcols(8) = 10 'Shock Value
readcols(9) = 11 'Shock Type
thisRow = 1
For thisScen = 1 To UBound(scenNames, 1)
'MsgBox (scenNames(thisScen, 1))
'open file
Application.EnableEvents = False
Set sourceWB = Workbooks.Open(filename:=scenPath & scenNames(thisScen, 1) & ".csv", UpdateLinks:=False, ReadOnly:=True)
sourceWB.Activate
Application.EnableEvents = True
Set sourceWS = sourceWB.Worksheets(scenNames(thisScen, 1))
lastrow = lastWSrow(sourceWS)
'read into array and concatenate attribute columns
ReDim thisArr(1 To lastrow - 1, 1 To 4)
For i = 2 To lastrow
j = 1
thisArr(i - 1, 1) = sourceWS.Cells(i, readcols(j))
For j = 2 To 7
thisArr(i - 1, 1) = thisArr(i - 1, 1) & "|" & sourceWS.Cells(i, readcols(j))
Next j
j = 8
thisArr(i - 1, 2) = sourceWS.Cells(i, readcols(j))
j = 9
thisArr(i - 1, 3) = sourceWS.Cells(i, readcols(j))
j = 2
thisArr(i - 1, 4) = sourceWS.Cells(i, readcols(j)) 'currency entered again in its own column for easy lookup later
Next i
'close file
sourceWB.Close savechanges:=False
'sort array
Call quicksort(thisArr, 1, 1, UBound(thisArr, 1))
'get risk free shocks: array is in format [Currency TermBucket]
Dim riskFree() As Variant
ReDim riskFree(1 To UBound(currToRiskFree), 1 To UBound(termBuckets) + 1)
For i = 1 To UBound(riskFree, 1)
riskFree(i, 1) = currToRiskFree(i, 1)
For thisBucket = 1 To UBound(termBuckets)
thisArrRow = findInArrCol(currToRiskFree(i, 2) & "|" & termBuckets(thisBucket) & "||SHOCK", 1, thisArr)
If thisArrRow = 0 Then
MsgBox ("Error calculating risk free rate: Could not find " & riskFree(i, 2) & "|" & termBuckets(thisBucket) & "||SHOCK in" & scenNames(thisScen, 1))
Exit Sub
End If
'absolute shock
If thisArr(thisArrRow, 3) = "non-parallel shift" Then
riskFree(i, thisBucket + 1) = thisArr(thisArrRow, 2) * 10000
'relative shock
ElseIf thisArr(thisArrRow, 3) = "variable factor" Then
thisCurveMapRow = findInArrCol(currToRiskFree(i, 2), 1, curveNameToMarketData) 'get mapping market data curve name
thisCurveDataRow = findInArrCol(curveNameToMarketData(thisCurveMapRow, 2), 2, curveData) 'get curve data
'absolute shock = 10000 * abs(yield) * (relative shock - 1)
riskFree(i, thisBucket + 1) = 10000 * Abs(curveData(thisCurveDataRow, 2 + thisBucket)) * (thisArr(thisArrRow, 2) - 1)
'special case for SRF credit scenarios
ElseIf thisArr(thisArrRow, 3) = "NOT DEFINED" And (scenNames(thisScen, 1) = "Credit_Spread_Pos_Basis" Or scenNames(thisScen, 1) = "Credit_Spread_Neg_Basis" Or scenNames(thisScen, 1) = "Credit_Spread_Zero_Basis") Then
riskFree(i, thisBucket + 1) = 0
Else
MsgBox ("Error calculating risk free rate: Code can not handle Shock Type " & thisArr(thisArrRow, 3) & " for " & currToRiskFree(i, 2) & " in " & scenNames(thisScen, 1))
Exit Sub
End If
Next thisBucket
Next i
Call quicksort(riskFree, 1, 1, UBound(riskFree, 1))
'step through each curve and calculate shocks
For thisCurve = 1 To UBound(curveNames, 1)
arrshocks(thisRow, 1) = "IR"
arrshocks(thisRow + 1, 1) = "CR"
arrshocks(thisRow, 2) = scenNames(thisScen, 1)
arrshocks(thisRow + 1, 2) = scenNames(thisScen, 1)
arrshocks(thisRow, 3) = curveNames(thisCurve, 1)
arrshocks(thisRow + 1, 3) = curveNames(thisCurve, 1)
For thisBucket = 1 To UBound(termBuckets, 1)
'find curve in array
thisArrRow = findInArrCol(curveNames(thisCurve, 1) & "|" & termBuckets(thisBucket) & "||SHOCK", 1, thisArr)
If thisArrRow = 0 Then 'could not find curve in array
arrshocks(thisRow, 3 + thisBucket) = "ERROR: Could not find curve in scenario file"
arrshocks(thisRow + 1, 3 + thisBucket) = "ERROR: Could not find curve in scenario file"
Else
'write shock to array
thisRiskFreeRow = findInArrCol(thisArr(thisArrRow, 4), 1, riskFree)
'absolute shock
If thisArr(thisArrRow, 3) = "non-parallel shift" Then
'arrshocks(thisrow, 3 + thisBucket) = thisArr(thisArrRow, 2) * 10000 'TOTAL SHOCK
arrshocks(thisRow, 3 + thisBucket) = riskFree(thisRiskFreeRow, thisBucket + 1) 'IR SHOCK
arrshocks(thisRow + 1, 3 + thisBucket) = thisArr(thisArrRow, 2) * 10000 - arrshocks(thisRow, 3 + thisBucket) 'CR SHOCK
'relative shock
ElseIf thisArr(thisArrRow, 3) = "variable factor" Then
thisCurveMapRow = findInArrCol(curveNames(thisCurve, 1), 1, curveNameToMarketData) 'get mapping market data curve name
thisCurveDataRow = findInArrCol(curveNameToMarketData(thisCurveMapRow, 2), 2, curveData) 'get curve data
'absolute shock = 10000 * abs(yield) * (relative shock - 1)
'arrshocks(thisrow, 3 + thisBucket) = 10000 * Abs(curveData(thisCurveDataRow, 1 + thisBucket)) * (thisArr(thisArrRow, 2) - 1) 'TOTAL SHOCK
arrshocks(thisRow, 3 + thisBucket) = riskFree(thisRiskFreeRow, thisBucket + 1) 'IR SHOCK
arrshocks(thisRow + 1, 3 + thisBucket) = 10000 * Abs(curveData(thisCurveDataRow, 2 + thisBucket)) * (thisArr(thisArrRow, 2) - 1) - arrshocks(thisRow, 3 + thisBucket)
'special case for SRF credit scenarios
ElseIf thisArr(thisArrRow, 3) = "NOT DEFINED" And (scenNames(thisScen, 1) = "Credit_Spread_Pos_Basis" Or scenNames(thisScen, 1) = "Credit_Spread_Neg_Basis" Or scenNames(thisScen, 1) = "Credit_Spread_Zero_Basis") Then
arrshocks(thisRow, 3 + thisBucket) = 0
arrshocks(thisRow + 1, 3 + thisBucket) = 0
Else
arrshocks(thisRow, 1) = "IR - ERROR"
arrshocks(thisRow, 3 + thisBucket) = "ERROR: Shock Type '" & thisArr(thisArrRow, 3) & "' not coded for in this subroutine"
arrshocks(thisRow + 1, 1) = "CR - ERROR"
arrshocks(thisRow + 1, 3 + thisBucket) = "ERROR: Shock Type '" & thisArr(thisArrRow, 3) & "' not coded for in this subroutine"
End If
End If
Next thisBucket
thisRow = thisRow + 2
Next thisCurve
Next thisScen
'create file and save array data to it
ActiveWorkbook.Sheets("IR_CR_Shocks").Cells.ClearContents
ActiveWorkbook.Sheets("IR_CR_Shocks").Cells(1, 1).Value = "Shock type"
ActiveWorkbook.Sheets("IR_CR_Shocks").Cells(1, 2).Value = "Scenario"
ActiveWorkbook.Sheets("IR_CR_Shocks").Cells(1, 3).Value = "Curve"
ActiveWorkbook.Sheets("IR_CR_Shocks").Cells(1, 4).Value = "0"
ActiveWorkbook.Sheets("IR_CR_Shocks").Cells(1, 5).Value = "30"
ActiveWorkbook.Sheets("IR_CR_Shocks").Cells(1, 6).Value = "91"
ActiveWorkbook.Sheets("IR_CR_Shocks").Cells(1, 7).Value = "182"
ActiveWorkbook.Sheets("IR_CR_Shocks").Cells(1, 8).Value = "365"
ActiveWorkbook.Sheets("IR_CR_Shocks").Cells(1, 9).Value = "730"
ActiveWorkbook.Sheets("IR_CR_Shocks").Cells(1, 10).Value = "1095"
ActiveWorkbook.Sheets("IR_CR_Shocks").Cells(1, 11).Value = "1461"
ActiveWorkbook.Sheets("IR_CR_Shocks").Cells(1, 12).Value = "1826"
ActiveWorkbook.Sheets("IR_CR_Shocks").Cells(1, 13).Value = "2556"
ActiveWorkbook.Sheets("IR_CR_Shocks").Cells(1, 14).Value = "3652"
ActiveWorkbook.Sheets("IR_CR_Shocks").Cells(1, 15).Value = "5478"
ActiveWorkbook.Sheets("IR_CR_Shocks").Cells(1, 16).Value = "7305"
ActiveWorkbook.Sheets("IR_CR_Shocks").Cells(1, 17).Value = "10957"
ActiveWorkbook.Sheets("IR_CR_Shocks").Cells(1, 18).Value = "21914"
Call writeArrToWS(arrshocks, ActiveWorkbook.Sheets("IR_CR_Shocks").Range("A2"), True, UBound(arrshocks, 1), UBound(arrshocks, 2))
End SubOther included calls:
1)
Code:
Public Sub writeArrToWS(arr() As Variant, startCell As Range, fromTop As Boolean, nRows As Long, nCols As Long)
Dim i As Long, j As Long, startRow As Long, startCol As Long
Dim thisWS As Worksheet
Dim writeVal As Variant
Set thisWS = startCell.Worksheet
startRow = startCell.row
startCol = startCell.Column
'clear
For i = 1 To nRows
For j = 1 To nCols
thisWS.Cells(startRow + i - 1, startCol + j - 1).value = ""
Next j
Next i
'write
For i = 1 To WorksheetFunction.Min(nRows, UBound(arr, 1))
For j = 1 To nCols
If fromTop Then writeVal = arr(i, j) Else writeVal = arr(UBound(arr, 1) - i + 1, j)
thisWS.Cells(startRow + i - 1, startCol + j - 1).value = writeVal
Next j
Next i
End Sub2)
Code:
Sub quicksort(ByRef arr() As Variant, ByVal sortCol As Long, ByVal left As Long, ByVal right As Long)
If right > left Then
Dim pivotIndex As Long
pivotIndex = left + Int((right - left) / 2)
Dim pivotIndexNew As Long
pivotIndexNew = partition(arr, sortCol, left, right, pivotIndex)
Call quicksort(arr, sortCol, left, pivotIndexNew - 1)
Call quicksort(arr, sortCol, pivotIndexNew + 1, right)
End If
End Sub
