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:
=$D14*SUMIFS(Table1[Value],Table1[Map Code],$B14,Table1[Service],$A14,Table1[Flag],"TRUE",Table1[Period],Z$5,Table1[Type],$AA$4,Table1[Year],$Z$4)
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
when using 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
When using 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.
Worksheet_Change
event by chance? \$\endgroup\$RangeToArray()
orContains()
change the calculation mode? I would test the calculation mode the line before writing the data. \$\endgroup\$RangeToArray
andContains
; that way reviewers could copy and compile your code making fewer assumptions. \$\endgroup\$