I have a piece of code (below) that checks a data table (45,000 rows) to see if the row matches any entries in a range elsewhere on the workbook (using custom functions). The routine then creates an array of Flags and writes that array back to a field in the table - so a series of Sumifs formulae reference only those records that are relevant to the user's selections.
Edited to add Context:
The data table is referenced by a Report sheet containing c. 22,000 Sumifs formulae (plus as many dependent formulae again) to create a Profit and Loss report. (and I know that it's probably not the best way to do it, but I'm bound by the end user, who wants it in excel and doesn't want to use a Pivot table, no matter how well designed). Maybe this is the reason that writing to the Table is so slow.
Here's one of the sumifs:
So I can add in some helper cells and make those a bit more efficient, but there's still a lot of them.
So here's the code
Sub flagselected() Dim datablock As Variant Dim x As Long, i As Integer Dim p As Integer Dim selectedUnits() As String Dim selectKey() As String Dim selectFlag() As Variant Dim startTime As Variant Dim midTime As Variant Dim endTime As Variant Dim postTrans As Variant Dim targetService As String, targetMapCode As Integer, multiplier As Integer Dim cell As Range, gap1 As Integer startTime = Now Application.ScreenUpdating = False Application.Calculation = xlCalculationManual datablock = Sheets("DataBlock").Range("Table1") selectedUnits = RangeToArray(Sheets("Tables").Range("SelectedCC")) ReDim selectKey(1 To UBound(datablock)) ReDim selectFlag(1 To UBound(datablock)) For x = LBound(datablock) To UBound(datablock) ' loops thru the datablock If Contains(selectedUnits, datablock(x, 2)) = True Then 'only considers this row if it's in selected units selectFlag(x) = True End If Next x midTime = Now selectFlag = Application.WorksheetFunction.Transpose(selectFlag) postTrans = Now ' Sheets("datablock").Range("table1[flag]").Value2 = selectFlag ' Commented out to test unload to range Sheets("datablock").Range("P2:p" & UBound(selectFlag)).Value2 = selectFlag ' this range is outside the Table endTime = Now Debug.Print "Started " & startTime Debug.Print "Variable filled " & midTime Debug.Print "Transposed " & postTrans Debug.Print "Unloaded to range " & endTime 'Application.Calculation = xlCalculationAutomatic Application.Calculation = xlCalculationSemiautomatic End Sub
The code seems to work fine (although I'm sure can be improved) but it's the last activity that's tripping me up. When I try to populate the Flag field in the table with the array, it takes 18 or 19 seconds. When I comment that row out and populate a range on the same worksheet but outside of the Table, it's near instantaneous.
Is there a table property or action that I can switch off for a short time while I write to it so that it's the same as writing to a simple range? There are a lot of formulae on the Workbook that reference the table, so I don't really want to convert it to a range and then recreate the table (unless that would leave formulae untouched?)
The results of the debug.print rows are as follows
Sheets("datablock").Range("table1[flag]").Value2 = selectFlag
Started 14/11/2019 09:15:01
Variable filled 14/11/2019 09:15:01
Transposed 14/11/2019 09:15:01
Unloaded to range 14/11/2019 09:15:19
Sheets("datablock").Range("P2:p" & UBound(selectFlag)).Value2 = selectFlag
Started 14/11/2019 09:18:30
Variable filled 14/11/2019 09:18:30
Transposed 14/11/2019 09:18:30
Unloaded to range 14/11/2019 09:18:30
Edited to add the custom functions. I'll try Mattieu's suggestions tomorrow and revert.
Function Contains(arr, v) As Boolean Dim rv As Boolean, lb As Long, ub As Long, i As Long lb = LBound(arr) ub = UBound(arr) For i = lb To ub If arr(i) = v Then rv = True Exit For End If Next i Contains = rv End Function Function RangeToArray(ByVal my_range As Range) As String() Dim vArray As Variant Dim sArray() As String Dim i As Long vArray = my_range.value ReDim sArray(1 To UBound(vArray)) For i = 1 To UBound(vArray) sArray(i) = vArray(i, 1) Next RangeToArray = sArray() End Function
Thanks for help with formatting Question and responses so far.