Petra
01-31-2007, 05:20 AM
Hi,
The code at the bottom was found after Googling ?vba to speed up MATCH in excel?.
My ?Kid-Brother?, a Computer Geek, was unable modify this code for me. He suggested I visit your site for some help.
Maybe someone would spend a few minutes looking at this?
?Update? sheet uses equations, functions & Named Ranges.
a) Match function in ?Col E? returns the row number in ?Col A? of matched item in ?Col D?
b) Index function in ?Col F? returns the data from the matched item in ?Col B? relative to ?Col E?
c) Index function in ?Col H? returns the data from the matched item in ?Col C? relative to ?Col E?
d) Named Range ?Items? for Matching
e) Named Range ?Table? for Indexing
.
The revised code below, would copy data from ?Col B? to ?Col E? and from ?Col C? to ?Col G? for each Match. As shown in the ?Modified? sheet.
Some sheets to be updated would have about 50K Items in ?Col A? and maybe 35K Items in ?Col D?
Option Explicit
Option Base 1 'ensure arrays start at 1, not 0
? Dermot Balson - January 1981
' adds up the total number of matches
' can be adapted to do something else when match found
Sub MatchArray()
Dim D1 As Variant, D2 As Variant
Dim C As New Collection
Dim i As Integer, j As Integer
Dim tCount As Integer
Dim t As Single
t = Timer 'set timer
'With ActiveSheet
With Sheets("Test")
D1 = .Range(.Cells(2, 1), .Cells(60000, 1).End(xlUp))
D2 = .Range(.Cells(2, 4), .Cells(60000, 4).End(xlUp))
End With
'store D2 in collection
For i = 1 To UBound(D2, 1)
C.Add CStr(i), CStr(D2(i, 1))
'first item is array sequence , second is string to lookup on
'both must be strings
Next i
'search
'set error trapping on
On Error Resume Next
For i = 1 To UBound(D1, 1)
'next line looks up the item from D1 in the collection, and converts the result
'to a number. If no error, gives the sequence number. So if the number is 45, it
'means B2(45,1) is a match. An error no match found.
j = Val(C(CStr(D1(i, 1))))
If Err = 0 Then 'no error, have a match
tCount = tCount + 1
Else 'no match, so reset error
Err = 0
End If
Next i
'report number of matches and time taken
t = Timer - t 'freeze timer
MsgBox "Found " & tCount & " matches in " & Format(t, "0.00") & " seconds", vbInformation, "Matched Items"
Range("cMethod") = t
End Sub
This would free-up a lot of time to use on other duties.
Thank you,
Petra
The code at the bottom was found after Googling ?vba to speed up MATCH in excel?.
My ?Kid-Brother?, a Computer Geek, was unable modify this code for me. He suggested I visit your site for some help.
Maybe someone would spend a few minutes looking at this?
?Update? sheet uses equations, functions & Named Ranges.
a) Match function in ?Col E? returns the row number in ?Col A? of matched item in ?Col D?
b) Index function in ?Col F? returns the data from the matched item in ?Col B? relative to ?Col E?
c) Index function in ?Col H? returns the data from the matched item in ?Col C? relative to ?Col E?
d) Named Range ?Items? for Matching
e) Named Range ?Table? for Indexing
.
The revised code below, would copy data from ?Col B? to ?Col E? and from ?Col C? to ?Col G? for each Match. As shown in the ?Modified? sheet.
Some sheets to be updated would have about 50K Items in ?Col A? and maybe 35K Items in ?Col D?
Option Explicit
Option Base 1 'ensure arrays start at 1, not 0
? Dermot Balson - January 1981
' adds up the total number of matches
' can be adapted to do something else when match found
Sub MatchArray()
Dim D1 As Variant, D2 As Variant
Dim C As New Collection
Dim i As Integer, j As Integer
Dim tCount As Integer
Dim t As Single
t = Timer 'set timer
'With ActiveSheet
With Sheets("Test")
D1 = .Range(.Cells(2, 1), .Cells(60000, 1).End(xlUp))
D2 = .Range(.Cells(2, 4), .Cells(60000, 4).End(xlUp))
End With
'store D2 in collection
For i = 1 To UBound(D2, 1)
C.Add CStr(i), CStr(D2(i, 1))
'first item is array sequence , second is string to lookup on
'both must be strings
Next i
'search
'set error trapping on
On Error Resume Next
For i = 1 To UBound(D1, 1)
'next line looks up the item from D1 in the collection, and converts the result
'to a number. If no error, gives the sequence number. So if the number is 45, it
'means B2(45,1) is a match. An error no match found.
j = Val(C(CStr(D1(i, 1))))
If Err = 0 Then 'no error, have a match
tCount = tCount + 1
Else 'no match, so reset error
Err = 0
End If
Next i
'report number of matches and time taken
t = Timer - t 'freeze timer
MsgBox "Found " & tCount & " matches in " & Format(t, "0.00") & " seconds", vbInformation, "Matched Items"
Range("cMethod") = t
End Sub
This would free-up a lot of time to use on other duties.
Thank you,
Petra