Clash Royale CLAN TAG#URR8PPP

VBA, code “not responding” in excel 2013, covert to formulas/new code

I have a code below that works perfectly fine in excel 2010. I've upgraded to 2013 and now my excel gets the not responding issue, along with the excel not working.

I've tried replacing this code with 16 formulas, EE2:ET6141. However I found this inefficient, time consuming, and uses much memory.

formula i am using to replace my code:

IF(AND(OR($BM:$BM="value1",$BM:$BM="value2",$BM:$BM="value3"),$BN:$BN<>"Excel",$BN:$BN<>"ITS"),$AT:$AT*(IFNA(VLOOKUP(EE$1&$S:$S,EQ_Shocks!E:F,2,FALSE),VLOOKUP(EE$1&"OTHERS",EQ_Shocks!E:F,2,FALSE))-1),"")

IF(AND(OR($BM:$BM="value1",$BM:$BM="value2",$BM:$BM="value3"),$BN:$BN<>"Excel",$BN:$BN<>"ITS"),$AT:$AT*(IFNA(VLOOKUP(EE$1&$S:$S,EQ_Shocks!E:F,2,FALSE),VLOOKUP(EE$1&"OTHERS",EQ_Shocks!E:F,2,FALSE))-1),"")

Logic something like: for each row where A1 = Stackoverflow, BM = value1 or value2 or value3 and BN not in Excel and not in ITS. then get value from EQ_shocks sheet.

code

It gets the not responding error at this loop
If thisEqShocks(1, 1) = "#EMPTY" Then I put a breakpoint at the end if and it takes long or not reponding trying to loop through this big if statement.

If thisEqShocks(1, 1) = "#EMPTY" Then

end if

I also notice this at the for loop , For thisScen = 1 To UBound(stressScenMapping, 1), takes long to respond through breakpoint Next thisScen I would say it is safe to say its this part of the code.

For thisScen = 1 To UBound(stressScenMapping, 1)

Next thisScen

Public Sub oldcode()
Application.ScreenUpdating = False

Dim i As Long, thisScen As Long, nRows As Long, nCols As Long
Dim stressWS As Worksheet

Set stressWS = Worksheets("EQ_Shocks")
Unprotect_Tab ("EQ_Shocks")
nRows = lastWSrow(stressWS)
nCols = lastWScol(stressWS)

Dim readcols() As Long
ReDim readcols(1 To nCols)

For i = 1 To nCols
readcols(i) = i
Next i

Dim eqShocks() As Variant
eqShocks = colsFromWStoArr(stressWS, readcols, False)

'read in database columns
Dim dataWs As Worksheet
Set dataWs = Worksheets("database")

nRows = lastRow(dataWs)
nCols = lastCol(dataWs)

Dim dataCols() As Variant
Dim riskSourceCol As Long
riskSourceCol = getWScolNum("RiskSource", dataWs)

ReDim readcols(1 To 4)
readcols(1) = getWScolNum("RiskReportProductType", dataWs)
readcols(2) = getWScolNum("Fair Value (USD)", dataWs)
readcols(3) = getWScolNum("Source Currency of the CUSIP that is denominated in", dataWs)
readcols(4) = riskSourceCol

dataCols = colsFromWStoArr(dataWs, readcols, True)

'read in scenario mappings
Dim mappingWS As Worksheet
Set mappingWS = Worksheets("mapping_ScenNames")

Dim stressScenMapping() As Variant
ReDim readcols(1 To 2): readcols(1) = 1: readcols(2) = 2
stressScenMapping = colsFromWStoArr(mappingWS, readcols, False, 2) 'include two extra columns to hold column number for IR and CR shocks

For i = 1 To UBound(stressScenMapping, 1)
stressScenMapping(i, 3) = getWScolNum(stressScenMapping(i, 2), dataWs)
If stressScenMapping(i, 2) <> "NA" And stressScenMapping(i, 3) = 0 Then
MsgBox ("Could not find " & stressScenMapping(i, 2) & " column in database")
Exit Sub
End If
Next i

ReDim readcols(1 To 4): readcols(1) = 1: readcols(2) = 2: readcols(3) = 3: readcols(4) = 4
stressScenMapping = filterOut(stressScenMapping, 2, "NA", readcols)

'calculate stress and write to database
Dim thisEqShocks() As Variant

Dim keepcols() As Long
ReDim keepcols(1 To UBound(eqShocks, 2))
For i = 1 To UBound(keepcols)
keepcols(i) = i
Next i

Dim thisCurrRow As Long

For thisScen = 1 To UBound(stressScenMapping, 1)

thisEqShocks = filterIn(eqShocks, 2, stressScenMapping(thisScen, 1), keepcols)

If thisEqShocks(1, 1) = "#EMPTY" Then
For i = 2 To nRows
If dataCols(i, 4) <> "Excel" And dataCols(i, 4) <> "OBI" And (dataCols(i, 1) = "value1" Or dataCols(i, 1) = "value2") Then
dataWs.Cells(i, stressScenMapping(thisScen, 3)).Value = "No shock found"
End If
Next i
Else 'calculate shocks
Call quicksort(thisEqShocks, 3, 1, UBound(thisEqShocks, 1))
For i = 2 To nRows
If dataCols(i, 4) <> "Excel" And dataCols(i, 4) <> "ITS" And (dataCols(i, 1) = "value1" Or dataCols(i, 1) = "value2" Or dataCols(i, 1) = "value3") Then
thisCurrRow = findInArrCol(dataCols(i, 3), 3, thisEqShocks)
If thisCurrRow = 0 Then 'could not find currency so use generic shock
thisCurrRow = findInArrCol("OTHERS", 3, thisEqShocks)
End If
If thisCurrRow = 0 Then
dataWs.Cells(i, stressScenMapping(thisScen, 3)).Value = "No shock found"
Else
dataWs.Cells(i, stressScenMapping(thisScen, 3)).Value = Replace(dataCols(i, 2), "-", 0) * (thisEqShocks(thisCurrRow, 4) - 1)
End If
End If
Next i
End If

Next thisScen
Application.ScreenUpdating = True
End Sub


adding function quicksort

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


Any suggestions would be appreciated.

F8

If thisEqShocks(1, 1) = "#EMPTY" Then

For thisScen = 1 To UBound(stressScenMapping, 1)

IsEmpty()

By clicking "Post Your Answer", you acknowledge that you have read our updated terms of service, privacy policy and cookie policy, and that your continued use of the website is subject to these policies.