Skip to main content
3 of 9
deleted 1 character in body
Greg
  • 559
  • 2
  • 12

Replace Member "In Place" within VBA Collection

Background

I encountered this issue a while back, where I tried to "set" the value of a member "in place", without changing its position within the Collection. Unfortunately, there is no way to determine the position of a key in a Collection, so the best I could do was

  1. .Remove() the old item, wherever it was; and
  2. .Add() its replacement, onto the end.

Solution

But then I had a brainwave! The .Add() method has the before and after arguments, which can insert a member next to an existing key.

So if the key already exists, we can

  1. mark the spot before it with a placeholder; and
  2. .Remove() its member; then
  3. .Add() its replacement after the placeholder, under the original key; and finally
  4. .Remove() the placeholder.

This leaves the replacement value under the same key and in the same position!

There remained the challenge of generating a unique placeholder, which would not clash with existing keys. Now let 𝑛 be the .Count of the Collection, and suppose we have the "worst case" scenario, where the keys are a sequence 𝕂 of 𝑛 numeric Strings: 𝕂 = {"1", "2", "3", ..., CStr(n)}. Even so, there must exist some 𝑖 ∈ 𝕀 in the sequence 𝕀 = {1, 2, 3, ..., 𝑛, 𝑛 + 1} of 𝑛 + 1 numbers, such that CStr(i) ∉ 𝕂.

I use this principle to generate the unique placeholder in linear time, with the Private helper Clx_NewKey().

Code

Clx.bas

The API exposes the following functions:

  • Clx_Set(): Set the value of a member "in place", either by key or anonymously by position.
  • Clx_Set(): Test if a member exists, either under a key or at a position.
Attribute VB_Name = "Clx"


' Set the value of a member "in place".
Public Sub Clx_Set(ByRef clx As Collection, _
    ByVal index As Variant, _
    ByRef value As Variant _
)
    If WorksheetFunction.IsNumber(index) Then
        clx.Add item := value, after := index
        clx.Remove index := index
    Else
        Dim placeholder As String: placeholder = Clx_NewKey(clx)
        
        clx.Add item := Null, key := placeholder, before := index
        clx.Remove index := index
        
        clx.Add item := value, key := index, after := placeholder
        clx.Remove index := placeholder
    End If
End Sub


' Test if a member exists.
Public Function Clx_Has(ByRef clx As Collection, _
    ByVal index As Variant _
) As Boolean
    On Error GoTo Fail
    clx.Item index := index
    
    Clx_Has = True
    Exit Function
    
Fail:
    Clx_Has = False
End Function


' Generate a unique key.
Private Function Clx_NewKey(ByRef clx As Collection, _
    Optional ByVal seed As Long = -2147483648, _
    Optional ByVal increment As Long = 1 _
) As String
    Dim i As long: i = seed
    Dim hit As Boolean: hit = False
    
    Dim key As String
    
    While Not hit
        key = CStr(i)
        hit = Not Clx_Has(clx, index := key)
        i = i + increment       
    Wend
    
    Clx_NewKey = key
End Function

Test_Clx.bas

See below for the output.

Attribute VB_Name = "Test_Clx"


Public Sub Test()
    Dim colx As Collection: Set colx = New Collection
    
    
    ' ########################
    ' ## Initial Collection ##
    ' ########################
    
    Debug.Print "===== Initial Collection ====="
    Debug.Print
    
    colx.Add "val_1", "key_1"
    colx.Add "val_2", "key_2"
    colx.Add "val_3", "key_3"
    
    
    Debug.Print "colx(1) = '" & colx(1) & "'"
    Debug.Print "colx('key_1') = " & colx("key_1") & "'"
    Debug.Print
    
    Debug.Print "colx(2) = '" & colx(2) & "'"
    Debug.Print "colx('key_2') = '" & colx("key_2") & "'"
    Debug.Print
    
    Debug.Print "colx(3) = '" & colx(3) & "'"
    Debug.Print "colx('key_3') = '" & colx("key_3") & "'"
    Debug.Print: Debug.Print: Debug.Print
    
    
    
    ' ################
    ' ## Set by Key ##
    ' ################
    
    Debug.Print "===== Set by Key ====="
    Debug.Print
    
    Debug.Print "Clx_Has(colx, 'key_1') = " & Clx.Clx_Has(colx, "key_1")
    Debug.Print "Clx_Set colx, 'key_1', 'val_1.2'"
    Clx.Clx_Set colx, "key_1", "val_1.2"
    Debug.Print
    
    Debug.Print "colx(1) = '" & colx(1) & "'"
    Debug.Print "colx('key_1') = " & colx("key_1") & "'"
    Debug.Print
    
    Debug.Print "colx(2) = '" & colx(2) & "'"
    Debug.Print "colx('key_2') = '" & colx("key_2") & "'"
    Debug.Print
    
    Debug.Print "colx(3) = '" & colx(3) & "'"
    Debug.Print "colx('key_3') = '" & colx("key_3") & "'"
    Debug.Print: Debug.Print: Debug.Print
    
    
    
    ' #####################
    ' ## Set by Position ##
    ' #####################
    
    Debug.Print "===== Set by Position ====="
    Debug.Print
    
    Debug.Print "Clx_Has(colx, 1) = " & Clx.Clx_Has(colx, 1)
    Debug.Print "Clx_Set colx, 1, 'val_1.3'"
    Clx.Clx_Set colx, 1, "val_1.3"
    Debug.Print
    
    Debug.Print "colx(1) = '" & colx(1) & "'"
    ' Debug.Print "colx('key_1') = " & colx("key_1") & "'"
    Debug.Print
    
    Debug.Print "colx(2) = '" & colx(2) & "'"
    Debug.Print "colx('key_2') = '" & colx("key_2") & "'"
    Debug.Print
    
    Debug.Print "colx(3) = '" & colx(3) & "'"
    Debug.Print "colx('key_3') = '" & colx("key_3") & "'"
    Debug.Print: Debug.Print: Debug.Print
End Sub

Output

===== Initial Collection =====

colx(1) = 'val_1'
colx('key_1') = val_1'

colx(2) = 'val_2'
colx('key_2') = 'val_2'

colx(3) = 'val_3'
colx('key_3') = 'val_3'



===== Set by Key =====

Clx_Has(colx, 'key_1') = True
Clx_Set colx, 'key_1', 'val_1.2'

colx(1) = 'val_1.2'
colx('key_1') = val_1.2'

colx(2) = 'val_2'
colx('key_2') = 'val_2'

colx(3) = 'val_3'
colx('key_3') = 'val_3'



===== Set by Position =====

Clx_Has(colx, 1) = True
Clx_Set colx, 1, 'val_1.3'

colx(1) = 'val_1.3'

colx(2) = 'val_2'
colx('key_2') = 'val_2'

colx(3) = 'val_3'
colx('key_3') = 'val_3'
Greg
  • 559
  • 2
  • 12