Optimize VBA array instead of range?

Question

On the sheet that contains about 700K row, I display on a column the last value in past row where ID is located of the current row

With my VBA code, it takes few hours How can I optimize that ? someone advice to change my code when using ubound but too complex for me ... :(

Can you help me ?

Sub Seekvba()
    Dim C As Range, where As Range, whatt As String
    Dim i As Long

    Dim LastRow As Long
    With ActiveSheet
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    End With


    For i = 2 To LastRow

        On Error Resume Next
        whatt = Range("O" + CStr(i)).Value
        Set C = Range("O1:O" + CStr(i - 1))
        Set where = C.Find(what:=whatt, after:=C(1), searchdirection:=xlPrevious, lookat:=xlWhole)
        Cells(i, "S").Value = Mid(where.Address(0, 0), 2)
        i = i + 1
        Next i



    End Sub

Tim Williams · Accepted Answer · 2019-05-19 19:22:15Z

3

Single pass with no back-tracking:

Sub Tester()

    Dim dataIn, dataOut(), dict, i, rng As Range, v, t

    Set dict = CreateObject("scripting.dictionary")

    Set rng = Range("O2:O700000")

    'set up some test data
    With rng
        .Formula = "=""Sample_"" & ROUND(RAND()*10,0)"
        .Value = .Value
    End With

    t = Timer

    dataIn = rng.Value
    ReDim dataOut(1 To UBound(dataIn, 1), 1 To 1)

    For i = LBound(dataIn, 1) To UBound(dataIn, 1)
        v = dataIn(i, 1)
        If Not dict.exists(v) Then
            dict.Add v, i
        Else
            dataOut(i, 1) = dict(v) + 1 'adjust for Row start=2
            dict(v) = i 'remember this next row
        End If
    Next i

    rng.Offset(0, 4).Value = dataOut

    Debug.Print Timer - t

End Sub

About 3 sec for 700k rows.

edited May 19, 2019 at 19:22

answered May 19, 2019 at 19:11

Tim Williams

169k8 gold badges104 silver badges143 bronze badges

Sign up to request clarification or add additional context in comments.

Comments

Love Coding · Accepted Answer · 2019-05-19 15:15:25Z

If your worksheet look like this, you can try the code below to produce the output at column S, Array is a better solution when dealing with thousand rows.

Sub arraySearch()

Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("DATA") 'Name of your worksheet

Dim myData() As String 'Data Array Declaration
ReDim myData(1 To sh.Range("O" & Rows.Count).End(xlUp).Row) 'Declare size of the array

Dim result() As String 'Result Array Declaration
ReDim result(1 To sh.Range("O" & Rows.Count).End(xlUp).Row) 'Declare size of the array

'Transfer worksheet data to to myData Array
For a = 2 To sh.Range("O" & Rows.Count).End(xlUp).Row
    myData(a) = sh.Range("O" & a).Value
Next a

'Trying to convert your code, based on my understanding
'if the current row value is found from the previous row, that row number
'should be placed to column S
Dim whatt As String
For a = 2 To UBound(myData)
    whatt = myData(a)
    For b = a - 1 To 1 Step -1
        If whatt = myData(b) Then
            result(a) = b
            Exit For
        End If
    Next b
Next a

'Return the result value to column S
For a = 2 To UBound(result)
    sh.Range("S" & a).Value = result(a)
Next a

End Sub

Slai · Accepted Answer · 2019-05-19 16:53:04Z

1

Optimally there should be just one call to Excel to get the data, and one to set all results at once :

Dim a, lastRow As Long, i As Long, j As Long
LastRow = Cells(Rows.Count, "O").End(xlUp).Row
a = Range("O1:O" + LastRow)

For i = UBound(a) To 2 Step -1
    For j = i - 1 To 1 Step -1
        If a(i, 1) = a(j, 1) Then
            a(i, 1) = j
            j = -1
            Exit For
        End If
    Next
    If j >= 0 Then a(i, 1) = Empty
Next

a(1, 1) = Empty
Range("S1:S" + LastRow) = a

answered May 19, 2019 at 16:53

Slai

23k5 gold badges49 silver badges55 bronze badges

Collectives™ on Stack Overflow

Optimize VBA array instead of range?

3 Answers 3

Comments

Comments

Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

3 Answers 3

Comments

Comments

Comments

Your Answer

Sign up or log in

Post as a guest

Related