SHARE
TWEET

Fastest ValueRange function

a guest Jan 29th, 2019 60 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. Private Type LARGE_INTEGER
  2.     lowpart As Long
  3.     highpart As Long
  4. End Type
  5.  
  6. Private Declare Function QueryPerformanceCounter Lib "kernel32" (lpPerformanceCount As LARGE_INTEGER) As Long
  7. Private Declare Function QueryPerformanceFrequency Lib "kernel32" (lpFrequency As LARGE_INTEGER) As Long
  8. Private Const TWO_32 = 4294967296#
  9. Dim StartTime As Double
  10. Const ITERATION_MAX = 50000
  11.  
  12.  
  13. Private Function LI2Double(LI As LARGE_INTEGER) As Double
  14.   Dim Low As Double
  15.   Low = LI.lowpart
  16.   If Low < 0 Then
  17.     Low = Low + TWO_32
  18.   End If
  19.   LI2Double = LI.highpart * TWO_32 + Low
  20. End Function
  21. Private Sub StartTimer()
  22.   Dim PerfFrequency As LARGE_INTEGER
  23.   QueryPerformanceCounter PerfFrequency
  24.   StartTime = LI2Double(PerfFrequency)
  25. End Sub
  26. Private Function GetTimer() As Double
  27.   Dim PerfFrequency As LARGE_INTEGER, Freq As LARGE_INTEGER
  28.   QueryPerformanceCounter PerfFrequency
  29.   QueryPerformanceFrequency Freq
  30.   GetTimer = 1000# * (LI2Double(PerfFrequency) - StartTime) / LI2Double(Freq)
  31. End Function
  32.  
  33.  
  34.  
  35.  
  36.  
  37. Function RealUsedRange_Sancarn1(sht As Worksheet) As Range
  38.   'Get used range
  39.   Dim ur As Range
  40.   Set ur = sht.UsedRange
  41.  
  42.   'If used range is 1x1 then result is 1x1
  43.   If ur.Rows.Count = 1 And ur.Columns.Count = 1 Then
  44.     Set RealUsedRange_Sancarn1 = ur
  45.     Exit Function
  46.   End If
  47.  
  48.   'Find all non-empty cells
  49.   Dim x, y As Range
  50.   On Error Resume Next
  51.   Set x = ur.SpecialCells(xlCellTypeConstants)
  52.   Set y = ur.SpecialCells(xlCellTypeFormulas)
  53.   If Not (y Is Nothing Or x Is Nothing) Then
  54.     Set x = Application.Union(x, y)
  55.   ElseIf x Is Nothing Then
  56.     If y Is Nothing Then
  57.       ValueBoundingBox = Nothing
  58.       Exit Function
  59.     Else
  60.       Set x = y
  61.     End If
  62.   End If
  63.  
  64.   'Loop over all areas
  65.   Dim area As Range, colMin, colMax, rowMin, rowMax, colArea, colAreaMax, rowArea, rowAreaMax As Long
  66.  
  67.   'Set Initial (Large) values for colMin and rowMin
  68.   rowMin = 1048576
  69.   colMin = 16384
  70.  
  71.   'Loop over all areas selected by special cells.
  72.   For Each area In x.Areas
  73.     With area
  74.       'Calculate min and max rows/cols of area
  75.       colArea = .Column
  76.       colAreaMax = .Column + .Columns.Count - 1
  77.       rowArea = .row
  78.       rowAreaMax = .row + .Rows.Count - 1
  79.      
  80.       'Calculate min/max of range based on these values
  81.       If rowAreaMax > rowMax Then rowMax = rowAreaMax
  82.       If rowArea < rowMin Then rowMin = rowArea
  83.       If colAreaMax > colMax Then colMax = colAreaMax
  84.       If colArea < colMin Then colMin = colArea
  85.     End With
  86.   Next
  87.  
  88.   'Return bounding box
  89.   Set RealUsedRange_Sancarn1 = Range(sht.Cells(rowMin, colMin), sht.Cells(rowMax, colMax))
  90. End Function
  91.  
  92. Function RealUsedRange_Sancarn2(sht As Worksheet) As Range
  93.   'Get used range
  94.   Dim ur As Range
  95.   Set ur = sht.UsedRange
  96.  
  97.   'If used range is 1x1 then result is 1x1
  98.   If ur.Rows.Count = 1 And ur.Columns.Count = 1 Then
  99.     Set RealUsedRange_Sancarn2 = ur
  100.     Exit Function
  101.   End If
  102.  
  103.   'Find via array
  104.   'Get array of all values:
  105.   On Error GoTo URValueError
  106.     Dim v As Variant
  107.     v = ur.Value
  108.   On Error GoTo 0
  109.  
  110.   'Offsets if they exist
  111.   Dim offR, offC As Long
  112.   With ur
  113.     offR = .row - 1
  114.     offC = .Column - 1
  115.   End With
  116.  
  117.   'Define required values
  118.   Dim colMin, colMax, rowMin, rowMax, row, col As Long
  119.  
  120.   'Find min row:
  121.   For row = LBound(v, 1) To UBound(v, 1)
  122.     For col = LBound(v, 2) To UBound(v, 2)
  123.       If Not IsEmpty(v(row, col)) Then
  124.         rowMin = row
  125.         GoTo NextNum
  126.       End If
  127.     Next
  128.   Next
  129. NextNum:
  130.   'Find max row
  131.   For row = UBound(v, 1) To LBound(v, 1) Step -1
  132.     For col = LBound(v, 2) To UBound(v, 2)
  133.       If Not IsEmpty(v(row, col)) Then
  134.         rowMax = row
  135.         GoTo NextNum2
  136.       End If
  137.     Next
  138.   Next
  139. NextNum2:
  140.   'Find min col:
  141.   For col = LBound(v, 2) To UBound(v, 2)
  142.     For row = LBound(v, 1) To UBound(v, 1)
  143.       If Not IsEmpty(v(row, col)) Then
  144.         colMin = col
  145.         GoTo NextNum3
  146.       End If
  147.     Next
  148.    
  149.   Next
  150. NextNum3:
  151.   'Find max col
  152.   For col = UBound(v, 2) To LBound(v, 2) Step -1
  153.     For row = LBound(v, 1) To UBound(v, 1)
  154.       If Not IsEmpty(v(row, col)) Then
  155.         colMax = col
  156.         GoTo NextNum4
  157.       End If
  158.     Next
  159.   Next
  160. NextNum4:
  161.   Set RealUsedRange_Sancarn2 = Range(sht.Cells(offR + rowMin, offC + colMin), sht.Cells(offR + rowMax, offC + colMax))
  162.   Exit Function
  163. URValueError:
  164.   If Err.Number = 7 Then 'Out of memory error:
  165.     'If out of memory, fall back on VBasic2000's version. It's not optimal but it doesn't have memory issues!
  166.     Dim firstCell, lastCell As Range
  167.     With sht
  168.       Set firstCell = .Cells.Find("*", .Cells(1, 1), XlFindLookIn.xlFormulas, , XlSearchOrder.xlByRows)
  169.       If Not firstCell Is Nothing Then
  170.         Set lastCell = .Cells.Find("*", .Cells(1048576, 16384), XlFindLookIn.xlFormulas, , XlSearchOrder.xlByColumns, xlPrevious)
  171.         Set RealUsedRange_Sancarn2 = .Range(firstCell, lastCell)
  172.       End If
  173.     End With
  174.   Else
  175.     'Raise unhandled error
  176.     Err.Raise Err.Number, Err.Source, Err.Description, Err.HelpFile, Err.HelpContext
  177.   End If
  178. End Function
  179.  
  180. Function RealUsedRange_VBasic2008(objWs As Worksheet) As Range
  181.     With objWs
  182.       If Not .Cells.Find("*", .Cells(.Rows.Count, .Columns.Count), -4123, , 1) Is Nothing Then
  183.         Set RealUsedRange_VBasic2008 = .Range( _
  184.           .Cells( _
  185.             .Cells.Find( _
  186.               "*", .Cells( _
  187.                 .Rows.Count, .Columns.Count _
  188.               ) _
  189.             ).row, .Cells.Find( _
  190.               "*", .Cells( _
  191.                 .Rows.Count, .Columns.Count _
  192.               ), , , 2 _
  193.             ).Column _
  194.           ), .Cells( _
  195.             .Cells.Find( _
  196.               "*", , , , 1, 2 _
  197.             ).row, .Cells.Find( _
  198.               "*", , , , 2, 2 _
  199.             ).Column _
  200.           ) _
  201.         )
  202.       End If
  203.     End With
  204. End Function
  205.  
  206. Function RealUsedRange_IAmNerd2000_1(ws As Worksheet) As Range
  207.   Dim rng As Range
  208.   Set rng = ws.UsedRange.Cells(1, 1)
  209.   Set RealUsedRange_IAmNerd2000_1 = Range(rng, rng.SpecialCells(xlLastCell, xlTextValues))
  210. End Function
  211.  
  212. Function RealUsedRange_Sancarn3(sht As Worksheet) As Range
  213.   'Get used range
  214.   Dim ur As Range
  215.   Set ur = sht.UsedRange
  216.  
  217.   'If used range is 1x1 then result is 1x1
  218.   If ur.Rows.Count = 1 And ur.Columns.Count = 1 Then
  219.     Set RealUsedRange_Sancarn3 = ur
  220.     Exit Function
  221.   End If
  222.  
  223.   'Find via array
  224.   'Get array of all values:
  225.   On Error GoTo URValueError
  226.     Dim v As Variant
  227.     v = ur.Value
  228.   On Error GoTo 0
  229.  
  230.   'Offsets if they exist
  231.   Dim offR, offC As Long
  232.   With ur
  233.     offR = .row - 1
  234.     offC = .Column - 1
  235.   End With
  236.  
  237.   'Define required values
  238.   Dim colMin, colMax, rowMin, rowMax, row, col As Long
  239.  
  240.   'Find min row:
  241.   Dim ubndR, ubndC, lbndR, lbndC As Long
  242.   lbndR = LBound(v, 1)
  243.   lbndC = LBound(v, 2)
  244.   ubndR = UBound(v, 1)
  245.   ubndC = UBound(v, 2)
  246.  
  247.   For row = lbndR To ubndR
  248.     For col = lbndC To ubndC
  249.       If Not IsEmpty(v(row, col)) Then
  250.         rowMin = row
  251.         GoTo NextNum
  252.       End If
  253.     Next
  254.   Next
  255. NextNum:
  256.   'Find max row
  257.   For row = ubndR To lbndR Step -1
  258.     For col = lbndC To ubndC
  259.       If Not IsEmpty(v(row, col)) Then
  260.         rowMax = row
  261.         GoTo NextNum2
  262.       End If
  263.     Next
  264.   Next
  265. NextNum2:
  266.   'Find min col:
  267.   For col = lbndC To ubndC
  268.     For row = lbndR To ubndR
  269.       If Not IsEmpty(v(row, col)) Then
  270.         colMin = col
  271.         GoTo NextNum3
  272.       End If
  273.     Next
  274.    
  275.   Next
  276. NextNum3:
  277.   'Find max col
  278.   For col = ubndC To lbndC Step -1
  279.     For row = lbndR To ubndR
  280.       If Not IsEmpty(v(row, col)) Then
  281.         colMax = col
  282.         GoTo NextNum4
  283.       End If
  284.     Next
  285.   Next
  286. NextNum4:
  287.   Set RealUsedRange_Sancarn3 = Range(sht.Cells(offR + rowMin, offC + colMin), sht.Cells(offR + rowMax, offC + colMax))
  288.   Exit Function
  289. URValueError:
  290.   If Err.Number = 7 Then 'Out of memory error:
  291.     'If out of memory, fall back on VBasic2000's version. It's not optimal but it doesn't have memory issues!
  292.     Dim firstCell, lastCell As Range
  293.     With sht
  294.       Set firstCell = .Cells.Find("*", .Cells(1, 1), XlFindLookIn.xlFormulas, , XlSearchOrder.xlByRows)
  295.       If Not firstCell Is Nothing Then
  296.         Set lastCell = .Cells.Find("*", .Cells(1048576, 16384), XlFindLookIn.xlFormulas, , XlSearchOrder.xlByColumns, xlPrevious)
  297.         Set RealUsedRange_Sancarn3 = .Range(firstCell, lastCell)
  298.       End If
  299.     End With
  300.   Else
  301.     'Raise unhandled error
  302.     Err.Raise Err.Number, Err.Source, Err.Description, Err.HelpFile, Err.HelpContext
  303.   End If
  304. End Function
  305.  
  306. Function RealUsedRange_IAmNerd2000_2(sht As Worksheet) As Range
  307.     'Get used range
  308.   Dim ur As Range
  309.   Set ur = sht.UsedRange
  310.  
  311.   'If used range is 1x1 then result is 1x1
  312.   If ur.Rows.Count = 1 And ur.Columns.Count = 1 Then
  313.     Set RealUsedRange_IAmNerd2000_2 = ur
  314.     Exit Function
  315.   End If
  316.  
  317.   'Find via array
  318.   'Get array of all values:
  319.   On Error GoTo URValueError
  320.     Dim v As Variant
  321.     v = ur.Value
  322.   On Error GoTo 0
  323.  
  324.   'Offsets if they exist
  325.   Dim offR, offC As Long
  326.   With ur
  327.     offR = .row - 1
  328.     offC = .Column - 1
  329.   End With
  330.  
  331.   'Define required values
  332.   Dim colMin, colMax, rowMin, rowMax, row, col As Long
  333.  
  334.   'Find min row:
  335.   Dim ubndR, ubndC, lbndR, lbndC, tmp As Long
  336.   lbndR = LBound(v, 1)
  337.   lbndC = LBound(v, 2)
  338.   ubndR = UBound(v, 1)
  339.   ubndC = UBound(v, 2)
  340.  
  341.   'Find top and bottom most rows:
  342.   For row = lbndR To ubndR
  343.     For col = lbndC To ubndC
  344.       tmp = ubndR - row + 1
  345.       If Not IsEmpty(v(tmp, col)) Then
  346.           rowMax = tmp
  347.       End If
  348.       If Not IsEmpty(v(row, col)) Then
  349.         rowMin = row
  350.       End If
  351.       If IsEmpty(rowMin) And IsEmpty(rowMax) Then
  352.           GoTo NextNum
  353.       End If
  354.     Next
  355.   Next
  356. NextNum:
  357.   'Find top and bottom most rows:
  358.   For col = lbndC To ubndC
  359.     For row = lbndR To ubndR
  360.       tmp = ubndC - col + 1
  361.       If Not IsEmpty(v(row, tmp)) Then
  362.           colMax = tmp
  363.       End If
  364.       If Not IsEmpty(v(row, col)) Then
  365.         colMin = col
  366.       End If
  367.       If IsEmpty(colMin) And IsEmpty(colMax) Then
  368.           GoTo NextNum2
  369.       End If
  370.     Next
  371.   Next
  372. NextNum2:
  373.   Set RealUsedRange_IAmNerd2000_2 = Range(sht.Cells(offR + rowMin, offC + colMin), sht.Cells(offR + rowMax, offC + colMax))
  374.   Exit Function
  375. URValueError:
  376.   If Err.Number = 7 Then 'Out of memory error:
  377.     'If out of memory, fall back on VBasic2000's version. It's not optimal but it doesn't have memory issues!
  378.     Dim firstCell, lastCell As Range
  379.     With sht
  380.       Set firstCell = .Cells.Find("*", .Cells(1, 1), XlFindLookIn.xlFormulas, , XlSearchOrder.xlByRows)
  381.       If Not firstCell Is Nothing Then
  382.         Set lastCell = .Cells.Find("*", .Cells(1048576, 16384), XlFindLookIn.xlFormulas, , XlSearchOrder.xlByColumns, xlPrevious)
  383.         Set RealUsedRange_IAmNerd2000_2 = .Range(firstCell, lastCell)
  384.       End If
  385.     End With
  386.   Else
  387.     'Raise unhandled error
  388.     Err.Raise Err.Number, Err.Source, Err.Description, Err.HelpFile, Err.HelpContext
  389.   End If
  390. End Function
  391.  
  392. Function RealUsedRange_VBasic2008_refac(sht As Worksheet) As Range
  393.   Dim firstCell, lastCell1, lastCell2 As Range
  394.   With sht
  395.     'Start at first cell in sheet, go forward and find next cell (i.e. first cell of RealUsedRange)
  396.     Set firstCell = .Cells.Find("*", .Cells(1, 1), Excel.XlFindLookIn.xlFormulas, , XlSearchOrder.xlByRows)
  397.     If Not firstCell Is Nothing Then
  398.         'Start at last cell in sheet, go back and find previous cell (i.e. last cell of RealUsedRange)
  399.         Set lastCell1 = .Cells.Find("*", .Cells(1, 1), XlFindLookIn.xlFormulas, , XlSearchOrder.xlByColumns, xlPrevious)
  400.         Set lastCell2 = .Cells.Find("*", .Cells(1, 1), XlFindLookIn.xlFormulas, , XlSearchOrder.xlByRows, xlPrevious)
  401.         'Find combined range between first and last cell
  402.         Set RealUsedRange_VBasic2008_refac = Range(firstCell, Range(lastCell1, lastCell2))
  403.     End If
  404.   End With
  405. End Function
  406.  
  407. Function RealUsedRange_Tinman(ws As Worksheet) As Range
  408.     Dim r As Long, c As Long
  409.     Dim data As Variant
  410.  
  411.     Dim flag As Boolean
  412.     With ws.UsedRange
  413.         If .Count = 1 Then
  414.             If Not (.Cells(1, 1)) Then Set RealUsedRange_Tinman = .Cells(1, 1)
  415.             Exit Function
  416.         End If
  417.  
  418.         data = .Value2
  419.         For r = 1 To UBound(data)
  420.             For c = 1 To UBound(data, 2)
  421.                 If Not IsEmpty(data(r, c)) Then
  422.                     flag = True
  423.                     Exit For
  424.                 End If
  425.             Next
  426.             If flag Then Exit For
  427.         Next
  428.         'There is no data
  429.         If Not flag Then
  430.             Set RealUsedRange_Tinman = .Cells(1, 1)
  431.             Exit Function
  432.         End If
  433.  
  434.         flag = False
  435.  
  436.         Dim r2 As Long, c2 As Long
  437.         For r2 = UBound(data) To r Step -1
  438.             For c2 = UBound(data, 2) To c Step -1
  439.                 If Not IsEmpty(data(r2, c2)) Then
  440.                     flag = True
  441.                     Exit For
  442.                 End If
  443.             Next
  444.             If flag Then Exit For
  445.         Next
  446.  
  447.         Set RealUsedRange_Tinman = ws.Range(.Cells(r, c), .Cells(r2, c2))
  448.     End With
  449.  
  450. End Function
  451.  
  452. 'Changes:
  453. 'V2 - Initial version using arrays by Sancarn.
  454. 'V3 - IAmNerd2000: Store ubound, lbound to prevent recalculation after compilation.
  455. 'V3 - MacroMark:   Added fallback to VBasic2008's version for large ranges
  456. 'V4 - Tinman:      Changed Dim a,b,c as x to Dim a as x, b as x, c as x
  457. 'V4 - Tinman:      Changed use ur.countLarge instead of .rows.count and .columns.count for 1x1 check
  458. 'V4 - Tinman:      Use Value2 instead of Value1
  459. Function ValueRange(sht As Worksheet) As Range
  460.   'Get used range
  461.   Dim ur As Range
  462.   Set ur = sht.UsedRange
  463.  
  464.   'If used range is 1x1 then result is 1x1
  465.   If ur.CountLarge = 1 Then
  466.     Set ValueRange = ur
  467.     Exit Function
  468.   End If
  469.  
  470.   'Find via array
  471.   'Get array of all values:
  472.   On Error GoTo URValueError
  473.     Dim v As Variant
  474.     v = ur.Value2
  475.   On Error GoTo 0
  476.  
  477.   'Offsets if they exist
  478.   Dim offR As Long, offC As Long
  479.   With ur
  480.     offR = .row - 1
  481.     offC = .Column - 1
  482.   End With
  483.  
  484.   'Define required values
  485.   Dim colMin As Long, colMax As Long, rowMin As Long, rowMax As Long, row As Long, col As Long
  486.  
  487.   'Find min row:
  488.   Dim ubndR As Long, ubndC As Long, lbndR As Long, lbndC As Long
  489.   lbndR = 1 'should always be 1
  490.   lbndC = 1 'should always be 1
  491.   ubndR = UBound(v, 1)
  492.   ubndC = UBound(v, 2)
  493.  
  494.   For row = lbndR To ubndR
  495.     For col = lbndC To ubndC
  496.       If Not IsEmpty(v(row, col)) Then
  497.         rowMin = row
  498.         GoTo NextNum
  499.       End If
  500.     Next
  501.   Next
  502. NextNum:
  503.   'Find max row
  504.   For row = ubndR To lbndR Step -1
  505.     For col = lbndC To ubndC
  506.       If Not IsEmpty(v(row, col)) Then
  507.         rowMax = row
  508.         GoTo NextNum2
  509.       End If
  510.     Next
  511.   Next
  512. NextNum2:
  513.   'Find min col:
  514.   For col = lbndC To ubndC
  515.     For row = lbndR To ubndR
  516.       If Not IsEmpty(v(row, col)) Then
  517.         colMin = col
  518.         GoTo NextNum3
  519.       End If
  520.     Next
  521.   Next
  522. NextNum3:
  523.   'Find max col
  524.   For col = ubndC To lbndC Step -1
  525.     For row = lbndR To ubndR
  526.       If Not IsEmpty(v(row, col)) Then
  527.         colMax = col
  528.         GoTo NextNum4
  529.       End If
  530.     Next
  531.   Next
  532. NextNum4:
  533.   Set ValueRange = Range(sht.Cells(offR + rowMin, offC + colMin), sht.Cells(offR + rowMax, offC + colMax))
  534.   Exit Function
  535. URValueError:
  536.   If Err.Number = 7 Then 'Out of memory error:
  537.     'If out of memory, fall back on VBasic2000's version. It's not optimal but it doesn't have memory issues!
  538.     Dim firstCell, lastCell As Range
  539.     With sht
  540.       Set firstCell = .Cells.Find("*", .Cells(1, 1), XlFindLookIn.xlFormulas, , XlSearchOrder.xlByRows)
  541.       If Not firstCell Is Nothing Then
  542.         Set lastCell = .Cells.Find("*", .Cells(1048576, 16384), XlFindLookIn.xlFormulas, , XlSearchOrder.xlByColumns, xlPrevious)
  543.         Set ValueRange = .Range(firstCell, lastCell)
  544.       End If
  545.     End With
  546.   Else
  547.     'Raise unhandled error
  548.     Err.Raise Err.Number, Err.Source, Err.Description, Err.HelpFile, Err.HelpContext
  549.   End If
  550. End Function
  551.  
  552. Sub CreateTestRange()
  553.   Dim arr As Variant
  554.   arr = Split("$B$2,$C$3,$E$4,$D$5,$E$8,$E$9,$F$9,$D$10", ",")
  555.   For i = LBound(arr) To UBound(arr)
  556.     Sheet1.Range(arr(i)).Value2 = IIf(i > 4, "string", i)
  557.   Next
  558.   Range("C13").Formula = "=""cool formula"""
  559.   Range("C14").Formula = "=""""" 'blank formula
  560.   Range("H11").Interior.Color = RGB(255, 255, 0)
  561. End Sub
  562.  
  563. 'If you fail this check then your function is incorrect
  564. Sub testAllFuncs()  
  565.   Application.ScreenUpdating = False
  566.  
  567.   Debug.Print "Iterations: " & ITERATION_MAX
  568.   Debug.Print "-----------------------------------------|--------|-------------|"
  569.   Debug.Print "FUNCTION                                 | Valid? | Performance |"
  570.   Debug.Print "-----------------------------------------|--------|-------------|"
  571.   Debug.Print testAll("Module1.RealUsedRange_Sancarn1")
  572.   Debug.Print testAll("Module1.RealUsedRange_Sancarn2")
  573.   Debug.Print testAll("Module1.RealUsedRange_VBasic2008")
  574.   Debug.Print testAll("Module1.RealUsedRange_IAmNerd2000_1")
  575.   Debug.Print testAll("Module1.RealUsedRange_Sancarn3")
  576.   Debug.Print testAll("Module1.RealUsedRange_IAmNerd2000_2")
  577.   Debug.Print testAll("Module1.RealUsedRange_VBasic2008_refac")
  578.   Debug.Print testAll("Module1.RealUsedRange_Tinman")
  579.   Debug.Print testAll("Module1.ValueRange")
  580.  
  581.   Application.ScreenUpdating = True
  582. End Sub
  583.  
  584. Private Function testAll(ByVal funcToRun As String) As String
  585.   Dim s1 As String, s2 As String, s3 As String
  586.   s1 = Left(funcToRun & Space(40), 40)
  587.   s2 = Left(testFunc(funcToRun) & Space(6), 6)
  588.   s3 = Left(testFuncPerf(funcToRun) & Space(11), 11)
  589.   testAll = s1 & " | " & s2 & " | " & s3 & " |"
  590. End Function
  591. Private Function testFunc(ByVal funcToRun As String) As String
  592.   testFunc = IIf(Application.Run(funcToRun, Sheet1).Address = "$B$2:$F$14", "YES", "NO")
  593. End Function
  594. Private Function testFuncPerf(ByVal funcToRun As String) As Double
  595.   StartTimer
  596.     For i = 1 To ITERATION_MAX
  597.       Application.Run funcToRun, Sheet1
  598.     Next
  599.   testFuncPerf = GetTimer()
  600. End Function
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
 
Top