reduce the time to lookup value

Hi all,

Recently i am facing 500k pieces of rows of data,
which every row consists of around 20 columns.


Normally we use index,match or vlookup or loop to get the data link together.

I am thinking is there a better way to shortern time to find every single of data by loop ,whatever.

May be according to the reference key, and do the sorting, and kick the useless data out from the extraction?

Attached is my example worksheet.
Hope guys can help me with this annoying problem...
Always work overnight.


Regards,
matthew

No, i have to vlookup the key, and get the whole row of data, afterall then kick out the data by using your method.

Sub specialLookUp()
    Dim keyword As String

    For j = 2 To 600000
    keyword = Sheets("result").Range("A" & j).Value
        If Sheets("export").Range("B" & j).Value = keyword Then
            Sheets("result").Rows(j +1).Value = Sheets("export").Rows(j).Value

        End If
    Next j
End Sub

after sorting, i can match the reference key with two sheets, then copy the whole row and follow your instructions delete the column

sorry for messy..
the first priority is i have to make sure the reference key must be the same, then extract the data from the behind columns,
sorting is a good way to eliminate time, but not 100% sure that i can link the data with the reference key correctly.

For example:
A 100
D 200
DD 2000
C 300
E 500
EE 600

expected result ( after sorting of col A, in order to minmize the calculation time of excel)
A 100
C 300
D 200
E 500
DD 2000
EE 600

copy after sorting is good, but i cant guarantee the sorting must be correct to link the data.
If the sorting goes wrong as not expected,
and became this

A
C
D
DD
E
EE

just copy the data behind is taking a risk..
i want to minimize the time with linking the reference like vlookup to make sure the accuracy of data. i only can think of sorting in order to minimize the "looking for" time of excel.

And wanna ask for a better solution.

See if this is faster

Sub test()
    Dim a, i As Long, ii As Long, w(1 To 7), myCols
    myCols = [{1, 2, 3, 5, 7, 10, 12}]
    With Sheets("expected result").Cells(1).CurrentRegion
        a = .Value
        With CreateObject("Scripting.Dictionary")
            .CompareMode = 1
            For i = 2 To UBound(a, 1)
                .Item(a(i, 1)) = w
            Next
            a = Sheets("raw data").Cells(1).CurrentRegion.Value
            For i = 2 To UBound(a, 1)
                If .exists(a(i, 1)) Then
                    For ii = 1 To UBound(myCols)
                        w(ii) = a(i, myCols(ii))
                    Next
                    .Item(a(i, 1)) = w
                End If
            Next
            a = .items
        End With
        .Offset(1).Resize(.Rows.Count - 1).Value = Application.Index(a, 0, 0)
    End With
End Sub

Missed

If I got 500 k rows of data, they are too slow to being vlookup, index,match as formula…

Sub test()
    Dim a, i As Long, ii As Long, w(1 To 6), myCols
    myCols = [{2, 3, 5, 7, 10, 12}]
    a = Sheets("raw data").Cells(1).CurrentRegion.Value
    With CreateObject("Scripting.Dictionary")
        .CompareMode = 1
        For i = 2 To UBound(a, 1)
            For ii = 1 To UBound(myCols)
                w(ii) = a(i, myCols(ii))
            Next
            .Item(a(i, 1)) = w
        Next
        a = Sheets("expected result").Cells(1).CurrentRegion.Value
        For i = 2 To UBound(a, 1)
            If .exists(a(i, 1)) Then
                For ii = 2 To UBound(a, 2)
                    a(i, ii) = .Item(a(i, 1))(ii - 1)
                Next
            End If
        Next
    End With
    Sheets("expected result").Cells(1).CurrentRegion.Value = a
End Sub

Originally Posted by jindon

Missed

Sub test()
    Dim a, i As Long, ii As Long, w(1 To 6), myCols
    myCols = [{2, 3, 5, 7, 10, 12}]
    a = Sheets("raw data").Cells(1).CurrentRegion.Value
    With CreateObject("Scripting.Dictionary")
        .CompareMode = 1
        For i = 2 To UBound(a, 1)
            For ii = 1 To UBound(myCols)
                w(ii) = a(i, myCols(ii))
            Next
            .Item(a(i, 1)) = w
        Next
        a = Sheets("expected result").Cells(1).CurrentRegion.Value
        For i = 2 To UBound(a, 1)
            If .exists(a(i, 1)) Then
                For ii = 2 To UBound(a, 2)
                    a(i, ii) = .Item(a(i, 1))(ii - 1)
                Next
            End If
        Next
    End With
    Sheets("expected result").Cells(1).CurrentRegion.Value = a
End Sub

Yes, Thank you Sir, It did work perfectly!!

another bravo job!

quite interesting method to deal with this prob.!!!
Thank you guys!

I like the way how you attack the problem... good work.