Using collection or dictionary faster

[YasserKhalil]

Hello everyone
In the following code, the code stores the values in column B-C-D-E in a collection named "Numbers" then subtract each number from the other and put the results in column L

Code: Select all

Sub StepA()
    Dim t As Double: t = Timer
    With ThisWorkbook.Worksheets(1)
        .Range("L:L").ClearContents
        Dim Numbers As New Collection
        Dim i As Integer, j As Integer
        i = 2: j = 2
        
        Dim temp As Double
        Dim emptyNo As Byte
        
        Do Until emptyNo >= 20
            For j = 2 To 5
                temp = .Cells(i, j).Value
                If temp <> 0 Then
                    Numbers.Add (temp)
                    emptyNo = 0
                Else
                    emptyNo = emptyNo + 1
                End If
            Next j
            i = i + 1
            
        Loop

        Dim k As Long
        k = 3
        .Cells(2, 12) = "Value "
        For i = 1 To Numbers.Count
            For j = 1 To Numbers.Count
                If i <> j Then .Cells(k, 12) = Abs(Numbers(i) - Numbers(j)): k = k + 1
            Next j
        Next i
    End With
    Debug.Print Timer - t
End Sub

I don't know if using the collection here is faster or is there another approach to make this faster as the values in columns B to E extend to about 5000 rows and this would take too much time.

[HansV]

This is a lot faster:

Code: Select all

Sub StepA()
    Dim t As Double
    Dim Numbers As New Collection
    Dim i As Long
    Dim j As Long
    Dim k As Long
    Dim temp As Double
    Dim emptyNo As Long
    Application.ScreenUpdating = False
    t = Timer
    With ThisWorkbook.Worksheets(1)
        .Range("L:L").ClearContents
        .Cells(2, 12) = "Value "

        i = 2
        Do Until emptyNo >= 20
            For j = 2 To 5
                temp = .Cells(i, j).Value
                If temp = 0 Then
                    emptyNo = emptyNo + 1
                Else
                    Numbers.Add (temp)
                    emptyNo = 0
                End If
            Next j
            i = i + 1
        Loop

        ReDim v(1 To Numbers.Count * (Numbers.Count - 1), 1 To 1) As Double
        k = 1
        For i = 1 To Numbers.Count
            For j = 1 To Numbers.Count
                If i <> j Then
                    v(k, 1) = Abs(Numbers(i) - Numbers(j))
                    k = k + 1
                End If
            Next j
        Next i
        .Range("L3").Resize(UBound(v, 1)).Value = v
    End With
    Debug.Print Timer - t
    Application.ScreenUpdating = True
End Sub

[YasserKhalil]

Thanks a lot, Mr. Hans
Best and Kind Regards