VBA For Loop Optimization. Loop slow in excel 2013.

[jrwrita]

Hi all,

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 need help optimizing this for use in excel 2013.

Any help would be appreciated.

#Empty is a string btw.

For thisScen = 1 To UBound(stressScenMapping, 1)


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


        If thisEqShocks(1, 1) = "[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Empty]#Empty[/URL] " 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

quicksort function:

	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

 

[jrwrita]

Now getting application-defined or object defined error. Not sure how I am getting this.

Ill post my updated code here, I also changed some of your variable names just so I remember it better:

Public Sub mrexcel()

    Application.ScreenUpdating = False
    
    Dim i As Long, thisScen As Long, nRows As Long, nCols As Long, lastColN As Long, lastRowN 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)


'    'close file
'    stressWB.Close savechanges:=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
    


' load entire Dataws sheet into a variant array
With Worksheets("database")
lastColN = .Cells(1, .Columns.count).End(xlToLeft).Column
lastRowN = .Cells(Rows.count, "A").End(xlUp).row
datawsarray = .Range(Cells(1, 1), Cells(lastRowN, lastColN))




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
' note cells reference changed to variant array
                    datawsarray(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
' note cells references changed to variant array
                    If thisCurrRow = 0 Then


                        datawsarray(i, stressScenMapping(thisScen, 3)).value = "No shock found"
                    Else
                        datawsarray(i, stressScenMapping(thisScen, 3)).value = Replace(dataCols(i, 2), "-", 0) * (thisEqShocks(thisCurrRow, 4) - 1)
                    End If
                End If
            Next i
        End If




    Next thisScen
' now write the entire sheet back again
 Worksheets(dataWs).Range(Cells(1, 1), Cells(lastRowN, lastColN)) = datawsarray


End With


Application.ScreenUpdating = True


End Sub

 

[offthelip]

which line are you getting the error on?
It is possible that you will get this error when you write the array back to the worksheet if you have got garbage in one of the cells . If this is the line which is causing the erro you can find which cell is the probelm by writing the array back one cell at a time
It will hopefully fall over at the cell which is causing the problem:
So comment out the line which writes the arayt back and put this in:

'Worksheets(dataWs).Range(Cells(1, 1), Cells(lastRowN, lastColN)) = datawsarray

For i = 1 To lastrowN
 For j = 1 To lastcoln
  Cells(i , j) = inarr(i, j)
 Next j
Next i

 

[jrwrita]

I am getting the error on the datawsarray line

 

[offthelip]

which datawsarray line?

 

[jrwrita]

which datawsarray line?

datawsarray = .Range(Cells(1, 1), Cells(lastRowN, lastColN))

 

[offthelip]

sorry my mistake that line should be:

datawsarray = .Range(.Cells(1, 1), .Cells(lastrow, lastcol))

you also need to change the line at the bottom that writes it back:

.Range(.Cells(1, 1), .Cells(lastrow, lastcol)) = datawsarray

 

[jrwrita]

thanks, I get past that part now,
now i get object required on

datawsarray(i, stressScenMapping(thisScen, 3)).value = Replace(dataCols(i, 2), "-", 0) * (thisEqShocks(thisCurrRow, 4) - 1)

 

[offthelip]

Try deleting the .value from each of the lines , you don't need it when writing to an array

                      datawsarray(i, stressScenMapping(thisScen, 3)) = "No shock found"                   
                    Else
                        datawsarray(i, stressScenMapping(thisScen, 3)) = Replace(dataCols(i, 2), "-", 0) * (thisEqShocks(thisCurrRow, 4) - 1)
                    End If

 

[JackDanIce]

datawsarray = .Range(.Cells(1, 1), .Cells(lastrow, lastcol))

Just helpful remark, this could be replaced with:

.Cells(1,1).Resize(lastrow, lastcol)

Which is a little simpler/easier (i.e. doesn't need the Range wrap around) and opposite direction

.Cells(1,1).Resize(ubound(datawsarray, 1), ubound(datawsarray, 2)).Value = datawsarray

The write back is slightly different as this accounts for an array who's size is not same size as input size

 

[jrwrita]

thank you so much! it works from what I've seen so far.
Btw, when i run this , after it writes to dataws, why does my table disappear? I have it named as a table and this disappears.