title: VBA/Formula, Mapping among sheets
body: <p>I have a code that I am having trouble running on excel 2013. 2010 works fine.</p>
  
  <p>I've been contemplating just doing formulas because I cannot get this to work.</p>
  
  <p>Here is the logic</p>
  
  <ol>
  <li><p>Only fill values in sheet X if this condition exists: In Sheet A ,  If column a = value 1 , value 2, or value 3
  and column b &lt;> value 4, &lt;> value 5</p></li>
  <li><p>Then lookup headers from sheet X into sheet Y. These headers will be in sheet Y column c.</p></li>
  <li><p>for the headers that are matched to sheet Y col c, find like data of sheet X. column c, and sheet Y. column d.  Going to use these as lookup for next column in sheet Y. For where there are mismatches use 'OTHERS' as value.</p></li>
  <li><p>for matched headers/columns return sheet Y column e (value) and multiply by sheet X. column d.  minus one. </p></li>
  <li><p>return all these values to sheet a where the headers are like.</p></li>
  </ol>
  
  <p>Sheet X (below formulas in stack and overflow cols would actually be calculated)</p>
  
  <pre><code>+-------------+-------------+------------+-------+-----------------+-------------+
  |  conditions | condition 2 | currency   | value |     stack       |  overflow   |
  +-------------+-------------+------------+-------+-----------------+-------------+
  | value 1     | value 10    | USD        |   100 | 100 * (.75 - 1) |             |
  | value 2     | value 7     | XRP        |   200 | 200 * (.50 - 1) |             |
  | value 3     | value 8     | USD        |   300 |                 | 300*(.65-1) |
  | value 1     | value 9     | XRP        |   400 |                 | 400*(.24-1) |
  +-------------+-------------+------------+-------+-----------------+-------------+
  </code></pre>
  
  <p>Sheet Y</p>
  
  <pre><code>+----------+----------+--------+
  | header   | currency |  value |
  +----------+----------+--------+
  | stack    | USD      |    .75 |
  | stack    | OTHER    |    .50 |
  | overflow | USD      |    .65 |
  | overflow | OTHER    |    .24 |
  +----------+----------+--------+
  </code></pre>
  
  <p>This code gets slow at the for loop at the bottom of the code.</p>
  
  <p>Here is my code:</p>
  
  <pre><code>Public Sub calc()
  
      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("condition 2", dataWs)
  
      ReDim readcols(1 To 4)
      readcols(1) = getWScolNum("value", dataWs)
      readcols(2) = getWScolNum("currency", dataWs)
      readcols(3) = getWScolNum("condition", 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) &lt;&gt; "NA" And stressScenMapping(i, 3) = 0 Then
              MsgBox ("Could not find " &amp; stressScenMapping(i, 2) &amp; " 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) &lt;&gt; "value 4" And dataCols(i, 4) &lt;&gt; "value 5" And (dataCols(i, 1) = "value 1" Or dataCols(i, 1) = "value 2") 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) &lt;&gt; "value 5" And dataCols(i, 4) &lt;&gt; "value 6" And (dataCols(i, 1) = "value 1" Or dataCols(i, 1) = "value 2" Or dataCols(i, 1) = "value 3") 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
  </code></pre>