79140829

Date: 2024-10-30 11:15:19
Score: 0.5
Natty:
Report link

Based on all the input I received and considering the speed needed and the large volume of data consulted each time (10k rows, with info in 600 columns), I built a cached solution, on top of the 'simple loop the table' macro.

So the datatable sheet has 2 cache collections (1 for raw tagcode data and 1 for tha calculated tagcode info string, based on 600 column info of all tagcode records). The cache of the tagcode related info is cleared whever something on the row of a tagcode is modified: so in the code of the datatable sheet:

Option Explicit
Public kCellCol As New Collection
Public kCellTraceCol As New Collection

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim c As Range
    For Each c In Target
        On Error Resume Next
        kCellCol.Remove (c.EntireRow.Cells(1, 1).Value)
        kCellTraceCol.Remove (c.EntireRow.Cells(1, 1).Value)
        On Error GoTo 0
    Next c
End Sub

Then, in the code/UDF that call to get the infoString or KcellCol of a tagcode, I try to retrieve it from the cache. If not there, I calculate (slowly) :) what's needed, put it in the cache and return the value:

Function KabelTrajectInfo(kabelCell As Range, Optional dummyRange As Range) As String
    Dim tagcode As String
    
    tagcode = kabelCell.EntireRow.Cells(1, 1).Value
    
    If tagcode = "" Then
        KabelTrajectInfo = calcKabelTrajectInfo(kabelCell)
        Debug.Print tagcode, "KcellInfo calc on blank"
    Else
        'first try to get it from cache
        On Error Resume Next
        KabelTrajectInfo = Blad1.kCellTraceCol(tagcode)
        If Err Then
            On Error GoTo 0
            Blad1.kCellTraceCol.Add Item:=calcKabelTrajectInfo(kabelCell), Key:=tagcode
        Else
            Debug.Print tagcode, "KcellInfo reuse"
        End If
        KabelTrajectInfo = Blad1.kCellTraceCol(tagcode)
    End If
End Function

The calcKabelTrajectInfo code does something similar and first looks if the KcellCol for that tagcode can be found in the cache, otherwise asks to do the actual scan loop, and build the string. To further optimise: while scanning all records for 1 missing tagcode, the opportunity is taken to also add to the cache other missing tagcode info it finds, since everything is being scanned anyway.

 Function calcKabelTrajectInfo(kabelCell As Range, Optional dummyRange As Range) As String
...
'Find all records van de tagcode
    If tagcode = "" Then
        kCellCol.Add Item:=kabelCell.EntireRow.Cells(1, 1)
    Else
        Set kCellCol = getTagcodeColFromCache(tagcode)
    End If
...
end
Private Function addTagcodeColToCache(tagcode As String) As Collection
    'gets the col and puts in cach, but while
    Dim tempCol As New Collection
    Dim c As Range
    
    Dim testCol As Collection

    'Loop through the tagcode of all records
    For Each c In Intersect(Sheets("Kabels").Range("A:A"), Sheets("Kabels").UsedRange())
        On Error Resume Next
        'check if also not missing from cache, so all missing in 1 go
        Set testCol = Blad1.kCellCol(c.Value)
        If Err Then
            tempCol.Add Item:=New Collection, Key:=c.Value
        End If
        
        tempCol(c.Value).Add Item:=c
        On Error GoTo 0
    Next c

    'add all new KcellCol's to the cache
    Dim col As Collection
    For Each col In tempCol
        Blad1.kCellCol.Add Item:=col, Key:=col(1).Value
    Next col
    
    Debug.Print tagcode, tempCol(tagcode).Count
    Set addTagcodeColToCache = tempCol(tagcode)
End Function
Private Function getTagcodeColFromCache(tagcode As String) As Collection
    Dim tempCol As Collection
    On Error Resume Next
    Set tempCol = Blad1.kCellCol(tagcode)
    If Err Then
        'Blad1.kCellCol.Add Item:=getTagcodeCol2(tagcode), Key:=tagcode
        Call addTagcodeColToCache(tagcode)
    Else
        Debug.Print tagcode, tempCol.Count, "reuse from cache"
    End If
    
    Set getTagcodeColFromCache = Blad1.kCellCol(tagcode)
End Function

Maybe it helps somebody. Thanks for your support, C.

Reasons:
  • Blacklisted phrase (0.5): Thanks
  • Long answer (-1):
  • Has code block (-0.5):
  • Self-answer (0.5):
  • Low reputation (1):
Posted by: Christof De Backere