![]() |
Any way to do this faster?
For simplicity I say I have 2 1-based 1-D arrays, both holding integer
numbers. Both arrays are sorted ascending. Would there be any faster way to determine that both arrays have no numbers in common other than with a double loop? As these arrays can be big (thousands) this could take a minute or so. I don't know C++ or Assembly, but that are the kind of things I am thinking of. Thanks for any advice. RBS |
Any way to do this faster?
Hello RBS,
1. Add the first array values into a collection. Do not check for errors. 2. Add the second array values into the same collection and check for errors. Any #457 errors are duplicates. Regards, Jim Cone San Francisco, USA http://www.realezsites.com/bus/primitivesoftware "RB Smissaert" wrote in message For simplicity I say I have 2 1-based 1-D arrays, both holding integer numbers. Both arrays are sorted ascending. Would there be any faster way to determine that both arrays have no numbers in common other than with a double loop? As these arrays can be big (thousands) this could take a minute or so. I don't know C++ or Assembly, but that are the kind of things I am thinking of. Thanks for any advice. RBS |
Any way to do this faster?
Just loop through the smaller array and use application.match() to see if
there's a match dim Arr1 as Variant dim Arr2 as variant dim iCtr as long dim res as variant dim MatchFound as boolean arr1 = array(1,2,3,4,5) arr2 = array(3,6,7) matchfound = false for ictr = lbound(arr2) to ubound(arr2) res = application.match(arr2(ictr),arr1,0) if isnumeric(res) then 'found a match matchfound = true exit for end if next ictr msgbox matchfound (watchout for typos. I composed it in the email window.) RB Smissaert wrote: For simplicity I say I have 2 1-based 1-D arrays, both holding integer numbers. Both arrays are sorted ascending. Would there be any faster way to determine that both arrays have no numbers in common other than with a double loop? As these arrays can be big (thousands) this could take a minute or so. I don't know C++ or Assembly, but that are the kind of things I am thinking of. Thanks for any advice. RBS -- Dave Peterson |
Any way to do this faster?
Thanks, will have a look at both suggestions.
Actually, I just found a way to speed this up, but that couldn't be seen from the way I put the question. Both arrays are variant arrays and I found I needed to do Val(array1element) = Val(array2element). This slows it up. If I make 2 new arrays re-dimmed with the same size, but now declared as long and transfer the values to compare to these new arrays and do the comparisons on that it speeds it up a lot. I started this routine with match, but found that a double loop was much faster. Will try again though. RBS "RB Smissaert" wrote in message ... For simplicity I say I have 2 1-based 1-D arrays, both holding integer numbers. Both arrays are sorted ascending. Would there be any faster way to determine that both arrays have no numbers in common other than with a double loop? As these arrays can be big (thousands) this could take a minute or so. I don't know C++ or Assembly, but that are the kind of things I am thinking of. Thanks for any advice. RBS |
Any way to do this faster?
RBS,
This demo code takes less than second to load and compare. Jim Cone San Francisco, USA '-------------------------------- Sub AreTheyTheSame() Dim colNumbers As VBA.Collection Dim arrOne() As String Dim arrTwo() As String Dim lngNum As Long Set colNumbers = New VBA.Collection ReDim arrOne(1 To 5000) ReDim arrTwo(1 To 10000) 'Load arrays For lngNum = 1 To 5000 arrOne(lngNum) = lngNum Next For lngNum = 1 To 10000 arrTwo(lngNum) = lngNum + 5000 Next 'Create a duplicate value arrTwo(10000) = 3000 'Load collection and check for duplicates For lngNum = 1 To UBound(arrOne) colNumbers.Add vbNullString, arrOne(lngNum) Next For lngNum = 1 To UBound(arrTwo) On Error Resume Next colNumbers.Add vbNullString, arrTwo(lngNum) If Err.Number = 457 Then MsgBox arrTwo(lngNum) & " is a duplicate. " Exit For End If Next Set colNumbers = Nothing End Sub'------------------------------------ "RB Smissaert" wrote in message ... Thanks, will have a look at both suggestions. Actually, I just found a way to speed this up, but that couldn't be seen from the way I put the question. Both arrays are variant arrays and I found I needed to do Val(array1element) = Val(array2element). This slows it up. If I make 2 new arrays re-dimmed with the same size, but now declared as long and transfer the values to compare to these new arrays and do the comparisons on that it speeds it up a lot. I started this routine with match, but found that a double loop was much faster. Will try again though. RBS |
Any way to do this faster?
Will have a look at that.
I am not interested in duplicates, but I need to know if there is a match and if so what the position is of the matching element in one of the arrays. Looking quickly at your code that should be possible. RBS "Jim Cone" wrote in message ... RBS, This demo code takes less than second to load and compare. Jim Cone San Francisco, USA '-------------------------------- Sub AreTheyTheSame() Dim colNumbers As VBA.Collection Dim arrOne() As String Dim arrTwo() As String Dim lngNum As Long Set colNumbers = New VBA.Collection ReDim arrOne(1 To 5000) ReDim arrTwo(1 To 10000) 'Load arrays For lngNum = 1 To 5000 arrOne(lngNum) = lngNum Next For lngNum = 1 To 10000 arrTwo(lngNum) = lngNum + 5000 Next 'Create a duplicate value arrTwo(10000) = 3000 'Load collection and check for duplicates For lngNum = 1 To UBound(arrOne) colNumbers.Add vbNullString, arrOne(lngNum) Next For lngNum = 1 To UBound(arrTwo) On Error Resume Next colNumbers.Add vbNullString, arrTwo(lngNum) If Err.Number = 457 Then MsgBox arrTwo(lngNum) & " is a duplicate. " Exit For End If Next Set colNumbers = Nothing End Sub'------------------------------------ "RB Smissaert" wrote in message ... Thanks, will have a look at both suggestions. Actually, I just found a way to speed this up, but that couldn't be seen from the way I put the question. Both arrays are variant arrays and I found I needed to do Val(array1element) = Val(array2element). This slows it up. If I make 2 new arrays re-dimmed with the same size, but now declared as long and transfer the values to compare to these new arrays and do the comparisons on that it speeds it up a lot. I started this routine with match, but found that a double loop was much faster. Will try again though. RBS |
Any way to do this faster?
Hi Jim,
Had a look at this, but I don't think I can use this method. I need to know if there is a match between elements in array1 and array2 and then when there is a match I need to copy the row of the matching element in array2 to a row with the same number as the matching row in array1 to a third array, array3. So when the add error occurs I need to know the position of the element in array2 (no problem there as I loop through it adding to the collection) and the position of the matching element in array1. This last one is the trouble and I just don't think that is possible without a second loop through array1. This would then lose any speed advantage. With the array being transferred to an array declared as long it is quick enough. This speeded it up about 7 times. Thanks in any case for the suggestion. RBS "Jim Cone" wrote in message ... RBS, This demo code takes less than second to load and compare. Jim Cone San Francisco, USA '-------------------------------- Sub AreTheyTheSame() Dim colNumbers As VBA.Collection Dim arrOne() As String Dim arrTwo() As String Dim lngNum As Long Set colNumbers = New VBA.Collection ReDim arrOne(1 To 5000) ReDim arrTwo(1 To 10000) 'Load arrays For lngNum = 1 To 5000 arrOne(lngNum) = lngNum Next For lngNum = 1 To 10000 arrTwo(lngNum) = lngNum + 5000 Next 'Create a duplicate value arrTwo(10000) = 3000 'Load collection and check for duplicates For lngNum = 1 To UBound(arrOne) colNumbers.Add vbNullString, arrOne(lngNum) Next For lngNum = 1 To UBound(arrTwo) On Error Resume Next colNumbers.Add vbNullString, arrTwo(lngNum) If Err.Number = 457 Then MsgBox arrTwo(lngNum) & " is a duplicate. " Exit For End If Next Set colNumbers = Nothing End Sub'------------------------------------ "RB Smissaert" wrote in message ... Thanks, will have a look at both suggestions. Actually, I just found a way to speed this up, but that couldn't be seen from the way I put the question. Both arrays are variant arrays and I found I needed to do Val(array1element) = Val(array2element). This slows it up. If I make 2 new arrays re-dimmed with the same size, but now declared as long and transfer the values to compare to these new arrays and do the comparisons on that it speeds it up a lot. I started this routine with match, but found that a double loop was much faster. Will try again though. RBS |
Any way to do this faster?
didn't you say the arrays are sorted?
Both arrays are sorted ascending No one seems to take notice of this critical fact. Perhaps use something like this: Sub ABC() Dim v1() As Long, v2() As Long ' Dummy code to generate ' two sorted arrays i = 1 j = 1 k = 1 For i = 1 To 100000 If Rnd() < 0.03 Then ReDim Preserve v1(1 To j) v1(j) = i j = j + 1 End If If Rnd() < 0.03 Then ReDim Preserve v2(1 To k) v2(k) = i k = k + 1 End If Next ' algorithm to check for match i = LBound(v1) j = LBound(v2) Do While i < UBound(v1) And j < UBound(v2) If v1(i) < v2(j) Then i = i + 1 ElseIf v2(j) < v1(i) Then j = j + 1 ElseIf v1(i) = v2(j) Then MsgBox "Match found at: " & vbNewLine & _ "v1(" & i & ")=" & v1(i) & vbNewLine & _ "v2(" & j & ")=" & v2(j) Exit Sub End If Loop MsgBox "Both have unique entries" End Sub -- Regards, Tom Ogilvy "RB Smissaert" wrote in message ... Will have a look at that. I am not interested in duplicates, but I need to know if there is a match and if so what the position is of the matching element in one of the arrays. Looking quickly at your code that should be possible. RBS "Jim Cone" wrote in message ... RBS, This demo code takes less than second to load and compare. Jim Cone San Francisco, USA '-------------------------------- Sub AreTheyTheSame() Dim colNumbers As VBA.Collection Dim arrOne() As String Dim arrTwo() As String Dim lngNum As Long Set colNumbers = New VBA.Collection ReDim arrOne(1 To 5000) ReDim arrTwo(1 To 10000) 'Load arrays For lngNum = 1 To 5000 arrOne(lngNum) = lngNum Next For lngNum = 1 To 10000 arrTwo(lngNum) = lngNum + 5000 Next 'Create a duplicate value arrTwo(10000) = 3000 'Load collection and check for duplicates For lngNum = 1 To UBound(arrOne) colNumbers.Add vbNullString, arrOne(lngNum) Next For lngNum = 1 To UBound(arrTwo) On Error Resume Next colNumbers.Add vbNullString, arrTwo(lngNum) If Err.Number = 457 Then MsgBox arrTwo(lngNum) & " is a duplicate. " Exit For End If Next Set colNumbers = Nothing End Sub'------------------------------------ "RB Smissaert" wrote in message ... Thanks, will have a look at both suggestions. Actually, I just found a way to speed this up, but that couldn't be seen from the way I put the question. Both arrays are variant arrays and I found I needed to do Val(array1element) = Val(array2element). This slows it up. If I make 2 new arrays re-dimmed with the same size, but now declared as long and transfer the values to compare to these new arrays and do the comparisons on that it speeds it up a lot. I started this routine with match, but found that a double loop was much faster. Will try again though. RBS |
Any way to do this faster?
Thanks, will have a look at that as well. So this is a different way to walk
the 2 arrays? This is the sequence as it is now, where RC1 and RC2 are the UBounds of the arrays. For r2 = 0 To RC2 - 1 For r1 = r1F To RC1 If arrNew1(r1) = arrNew2(r2) Then For c = 1 To CC2 arr3(r1, SC + c - 1) = arr2(r2, c) Next r1F = r1 + 1 Exit For End If If arrNew1(r1) arrNew2(r2) Then Exit For End If Next 'no point getting out early here Next This might actually be a similar idea as yours, although I haven't looked at it properly yet. RBS "Tom Ogilvy" wrote in message ... didn't you say the arrays are sorted? Both arrays are sorted ascending No one seems to take notice of this critical fact. Perhaps use something like this: Sub ABC() Dim v1() As Long, v2() As Long ' Dummy code to generate ' two sorted arrays i = 1 j = 1 k = 1 For i = 1 To 100000 If Rnd() < 0.03 Then ReDim Preserve v1(1 To j) v1(j) = i j = j + 1 End If If Rnd() < 0.03 Then ReDim Preserve v2(1 To k) v2(k) = i k = k + 1 End If Next ' algorithm to check for match i = LBound(v1) j = LBound(v2) Do While i < UBound(v1) And j < UBound(v2) If v1(i) < v2(j) Then i = i + 1 ElseIf v2(j) < v1(i) Then j = j + 1 ElseIf v1(i) = v2(j) Then MsgBox "Match found at: " & vbNewLine & _ "v1(" & i & ")=" & v1(i) & vbNewLine & _ "v2(" & j & ")=" & v2(j) Exit Sub End If Loop MsgBox "Both have unique entries" End Sub -- Regards, Tom Ogilvy "RB Smissaert" wrote in message ... Will have a look at that. I am not interested in duplicates, but I need to know if there is a match and if so what the position is of the matching element in one of the arrays. Looking quickly at your code that should be possible. RBS "Jim Cone" wrote in message ... RBS, This demo code takes less than second to load and compare. Jim Cone San Francisco, USA '-------------------------------- Sub AreTheyTheSame() Dim colNumbers As VBA.Collection Dim arrOne() As String Dim arrTwo() As String Dim lngNum As Long Set colNumbers = New VBA.Collection ReDim arrOne(1 To 5000) ReDim arrTwo(1 To 10000) 'Load arrays For lngNum = 1 To 5000 arrOne(lngNum) = lngNum Next For lngNum = 1 To 10000 arrTwo(lngNum) = lngNum + 5000 Next 'Create a duplicate value arrTwo(10000) = 3000 'Load collection and check for duplicates For lngNum = 1 To UBound(arrOne) colNumbers.Add vbNullString, arrOne(lngNum) Next For lngNum = 1 To UBound(arrTwo) On Error Resume Next colNumbers.Add vbNullString, arrTwo(lngNum) If Err.Number = 457 Then MsgBox arrTwo(lngNum) & " is a duplicate. " Exit For End If Next Set colNumbers = Nothing End Sub'------------------------------------ "RB Smissaert" wrote in message ... Thanks, will have a look at both suggestions. Actually, I just found a way to speed this up, but that couldn't be seen from the way I put the question. Both arrays are variant arrays and I found I needed to do Val(array1element) = Val(array2element). This slows it up. If I make 2 new arrays re-dimmed with the same size, but now declared as long and transfer the values to compare to these new arrays and do the comparisons on that it speeds it up a lot. I started this routine with match, but found that a double loop was much faster. Will try again though. RBS |
Any way to do this faster?
No it is completely different. I only use one Loop.
-- Regards, Tom Ogilvy "RB Smissaert" wrote in message ... Thanks, will have a look at that as well. So this is a different way to walk the 2 arrays? This is the sequence as it is now, where RC1 and RC2 are the UBounds of the arrays. For r2 = 0 To RC2 - 1 For r1 = r1F To RC1 If arrNew1(r1) = arrNew2(r2) Then For c = 1 To CC2 arr3(r1, SC + c - 1) = arr2(r2, c) Next r1F = r1 + 1 Exit For End If If arrNew1(r1) arrNew2(r2) Then Exit For End If Next 'no point getting out early here Next This might actually be a similar idea as yours, although I haven't looked at it properly yet. RBS "Tom Ogilvy" wrote in message ... didn't you say the arrays are sorted? Both arrays are sorted ascending No one seems to take notice of this critical fact. Perhaps use something like this: Sub ABC() Dim v1() As Long, v2() As Long ' Dummy code to generate ' two sorted arrays i = 1 j = 1 k = 1 For i = 1 To 100000 If Rnd() < 0.03 Then ReDim Preserve v1(1 To j) v1(j) = i j = j + 1 End If If Rnd() < 0.03 Then ReDim Preserve v2(1 To k) v2(k) = i k = k + 1 End If Next ' algorithm to check for match i = LBound(v1) j = LBound(v2) Do While i < UBound(v1) And j < UBound(v2) If v1(i) < v2(j) Then i = i + 1 ElseIf v2(j) < v1(i) Then j = j + 1 ElseIf v1(i) = v2(j) Then MsgBox "Match found at: " & vbNewLine & _ "v1(" & i & ")=" & v1(i) & vbNewLine & _ "v2(" & j & ")=" & v2(j) Exit Sub End If Loop MsgBox "Both have unique entries" End Sub -- Regards, Tom Ogilvy "RB Smissaert" wrote in message ... Will have a look at that. I am not interested in duplicates, but I need to know if there is a match and if so what the position is of the matching element in one of the arrays. Looking quickly at your code that should be possible. RBS "Jim Cone" wrote in message ... RBS, This demo code takes less than second to load and compare. Jim Cone San Francisco, USA '-------------------------------- Sub AreTheyTheSame() Dim colNumbers As VBA.Collection Dim arrOne() As String Dim arrTwo() As String Dim lngNum As Long Set colNumbers = New VBA.Collection ReDim arrOne(1 To 5000) ReDim arrTwo(1 To 10000) 'Load arrays For lngNum = 1 To 5000 arrOne(lngNum) = lngNum Next For lngNum = 1 To 10000 arrTwo(lngNum) = lngNum + 5000 Next 'Create a duplicate value arrTwo(10000) = 3000 'Load collection and check for duplicates For lngNum = 1 To UBound(arrOne) colNumbers.Add vbNullString, arrOne(lngNum) Next For lngNum = 1 To UBound(arrTwo) On Error Resume Next colNumbers.Add vbNullString, arrTwo(lngNum) If Err.Number = 457 Then MsgBox arrTwo(lngNum) & " is a duplicate. " Exit For End If Next Set colNumbers = Nothing End Sub'------------------------------------ "RB Smissaert" wrote in message ... Thanks, will have a look at both suggestions. Actually, I just found a way to speed this up, but that couldn't be seen from the way I put the question. Both arrays are variant arrays and I found I needed to do Val(array1element) = Val(array2element). This slows it up. If I make 2 new arrays re-dimmed with the same size, but now declared as long and transfer the values to compare to these new arrays and do the comparisons on that it speeds it up a lot. I started this routine with match, but found that a double loop was much faster. Will try again though. RBS |
Any way to do this faster?
I got a reply about this off-list from Peter T and I think his suggestion
was spot on. Use a binary search algorytyhm. This is in the book of Stephen Bullen, Professional Excel Development, which I have, so have used that and it speeds things up indeed. Thinking about it it was a bit silly to run the inner loop sequentially from LBound to UBound considering I knew both arrays were sorted. Will try your code as well though. RBS "Tom Ogilvy" wrote in message ... No it is completely different. I only use one Loop. -- Regards, Tom Ogilvy "RB Smissaert" wrote in message ... Thanks, will have a look at that as well. So this is a different way to walk the 2 arrays? This is the sequence as it is now, where RC1 and RC2 are the UBounds of the arrays. For r2 = 0 To RC2 - 1 For r1 = r1F To RC1 If arrNew1(r1) = arrNew2(r2) Then For c = 1 To CC2 arr3(r1, SC + c - 1) = arr2(r2, c) Next r1F = r1 + 1 Exit For End If If arrNew1(r1) arrNew2(r2) Then Exit For End If Next 'no point getting out early here Next This might actually be a similar idea as yours, although I haven't looked at it properly yet. RBS "Tom Ogilvy" wrote in message ... didn't you say the arrays are sorted? Both arrays are sorted ascending No one seems to take notice of this critical fact. Perhaps use something like this: Sub ABC() Dim v1() As Long, v2() As Long ' Dummy code to generate ' two sorted arrays i = 1 j = 1 k = 1 For i = 1 To 100000 If Rnd() < 0.03 Then ReDim Preserve v1(1 To j) v1(j) = i j = j + 1 End If If Rnd() < 0.03 Then ReDim Preserve v2(1 To k) v2(k) = i k = k + 1 End If Next ' algorithm to check for match i = LBound(v1) j = LBound(v2) Do While i < UBound(v1) And j < UBound(v2) If v1(i) < v2(j) Then i = i + 1 ElseIf v2(j) < v1(i) Then j = j + 1 ElseIf v1(i) = v2(j) Then MsgBox "Match found at: " & vbNewLine & _ "v1(" & i & ")=" & v1(i) & vbNewLine & _ "v2(" & j & ")=" & v2(j) Exit Sub End If Loop MsgBox "Both have unique entries" End Sub -- Regards, Tom Ogilvy "RB Smissaert" wrote in message ... Will have a look at that. I am not interested in duplicates, but I need to know if there is a match and if so what the position is of the matching element in one of the arrays. Looking quickly at your code that should be possible. RBS "Jim Cone" wrote in message ... RBS, This demo code takes less than second to load and compare. Jim Cone San Francisco, USA '-------------------------------- Sub AreTheyTheSame() Dim colNumbers As VBA.Collection Dim arrOne() As String Dim arrTwo() As String Dim lngNum As Long Set colNumbers = New VBA.Collection ReDim arrOne(1 To 5000) ReDim arrTwo(1 To 10000) 'Load arrays For lngNum = 1 To 5000 arrOne(lngNum) = lngNum Next For lngNum = 1 To 10000 arrTwo(lngNum) = lngNum + 5000 Next 'Create a duplicate value arrTwo(10000) = 3000 'Load collection and check for duplicates For lngNum = 1 To UBound(arrOne) colNumbers.Add vbNullString, arrOne(lngNum) Next For lngNum = 1 To UBound(arrTwo) On Error Resume Next colNumbers.Add vbNullString, arrTwo(lngNum) If Err.Number = 457 Then MsgBox arrTwo(lngNum) & " is a duplicate. " Exit For End If Next Set colNumbers = Nothing End Sub'------------------------------------ "RB Smissaert" wrote in message ... Thanks, will have a look at both suggestions. Actually, I just found a way to speed this up, but that couldn't be seen from the way I put the question. Both arrays are variant arrays and I found I needed to do Val(array1element) = Val(array2element). This slows it up. If I make 2 new arrays re-dimmed with the same size, but now declared as long and transfer the values to compare to these new arrays and do the comparisons on that it speeds it up a lot. I started this routine with match, but found that a double loop was much faster. Will try again though. RBS |
Any way to do this faster?
Think you will find a binary search slower than what I have proposed.
Particularly since you are trying not to match. -- Regards, Tom Ogilvy "RB Smissaert" wrote in message ... I got a reply about this off-list from Peter T and I think his suggestion was spot on. Use a binary search algorytyhm. This is in the book of Stephen Bullen, Professional Excel Development, which I have, so have used that and it speeds things up indeed. Thinking about it it was a bit silly to run the inner loop sequentially from LBound to UBound considering I knew both arrays were sorted. Will try your code as well though. RBS "Tom Ogilvy" wrote in message ... No it is completely different. I only use one Loop. -- Regards, Tom Ogilvy "RB Smissaert" wrote in message ... Thanks, will have a look at that as well. So this is a different way to walk the 2 arrays? This is the sequence as it is now, where RC1 and RC2 are the UBounds of the arrays. For r2 = 0 To RC2 - 1 For r1 = r1F To RC1 If arrNew1(r1) = arrNew2(r2) Then For c = 1 To CC2 arr3(r1, SC + c - 1) = arr2(r2, c) Next r1F = r1 + 1 Exit For End If If arrNew1(r1) arrNew2(r2) Then Exit For End If Next 'no point getting out early here Next This might actually be a similar idea as yours, although I haven't looked at it properly yet. RBS "Tom Ogilvy" wrote in message ... didn't you say the arrays are sorted? Both arrays are sorted ascending No one seems to take notice of this critical fact. Perhaps use something like this: Sub ABC() Dim v1() As Long, v2() As Long ' Dummy code to generate ' two sorted arrays i = 1 j = 1 k = 1 For i = 1 To 100000 If Rnd() < 0.03 Then ReDim Preserve v1(1 To j) v1(j) = i j = j + 1 End If If Rnd() < 0.03 Then ReDim Preserve v2(1 To k) v2(k) = i k = k + 1 End If Next ' algorithm to check for match i = LBound(v1) j = LBound(v2) Do While i < UBound(v1) And j < UBound(v2) If v1(i) < v2(j) Then i = i + 1 ElseIf v2(j) < v1(i) Then j = j + 1 ElseIf v1(i) = v2(j) Then MsgBox "Match found at: " & vbNewLine & _ "v1(" & i & ")=" & v1(i) & vbNewLine & _ "v2(" & j & ")=" & v2(j) Exit Sub End If Loop MsgBox "Both have unique entries" End Sub -- Regards, Tom Ogilvy "RB Smissaert" wrote in message ... Will have a look at that. I am not interested in duplicates, but I need to know if there is a match and if so what the position is of the matching element in one of the arrays. Looking quickly at your code that should be possible. RBS "Jim Cone" wrote in message ... RBS, This demo code takes less than second to load and compare. Jim Cone San Francisco, USA '-------------------------------- Sub AreTheyTheSame() Dim colNumbers As VBA.Collection Dim arrOne() As String Dim arrTwo() As String Dim lngNum As Long Set colNumbers = New VBA.Collection ReDim arrOne(1 To 5000) ReDim arrTwo(1 To 10000) 'Load arrays For lngNum = 1 To 5000 arrOne(lngNum) = lngNum Next For lngNum = 1 To 10000 arrTwo(lngNum) = lngNum + 5000 Next 'Create a duplicate value arrTwo(10000) = 3000 'Load collection and check for duplicates For lngNum = 1 To UBound(arrOne) colNumbers.Add vbNullString, arrOne(lngNum) Next For lngNum = 1 To UBound(arrTwo) On Error Resume Next colNumbers.Add vbNullString, arrTwo(lngNum) If Err.Number = 457 Then MsgBox arrTwo(lngNum) & " is a duplicate. " Exit For End If Next Set colNumbers = Nothing End Sub'------------------------------------ "RB Smissaert" wrote in message ... Thanks, will have a look at both suggestions. Actually, I just found a way to speed this up, but that couldn't be seen from the way I put the question. Both arrays are variant arrays and I found I needed to do Val(array1element) = Val(array2element). This slows it up. If I make 2 new arrays re-dimmed with the same size, but now declared as long and transfer the values to compare to these new arrays and do the comparisons on that it speeds it up a lot. I started this routine with match, but found that a double loop was much faster. Will try again though. RBS |
Any way to do this faster?
Will compare both, but I do need to match.
I need to know the position of the element in array1 in array2. RBS "Tom Ogilvy" wrote in message ... Think you will find a binary search slower than what I have proposed. Particularly since you are trying not to match. -- Regards, Tom Ogilvy "RB Smissaert" wrote in message ... I got a reply about this off-list from Peter T and I think his suggestion was spot on. Use a binary search algorytyhm. This is in the book of Stephen Bullen, Professional Excel Development, which I have, so have used that and it speeds things up indeed. Thinking about it it was a bit silly to run the inner loop sequentially from LBound to UBound considering I knew both arrays were sorted. Will try your code as well though. RBS "Tom Ogilvy" wrote in message ... No it is completely different. I only use one Loop. -- Regards, Tom Ogilvy "RB Smissaert" wrote in message ... Thanks, will have a look at that as well. So this is a different way to walk the 2 arrays? This is the sequence as it is now, where RC1 and RC2 are the UBounds of the arrays. For r2 = 0 To RC2 - 1 For r1 = r1F To RC1 If arrNew1(r1) = arrNew2(r2) Then For c = 1 To CC2 arr3(r1, SC + c - 1) = arr2(r2, c) Next r1F = r1 + 1 Exit For End If If arrNew1(r1) arrNew2(r2) Then Exit For End If Next 'no point getting out early here Next This might actually be a similar idea as yours, although I haven't looked at it properly yet. RBS "Tom Ogilvy" wrote in message ... didn't you say the arrays are sorted? Both arrays are sorted ascending No one seems to take notice of this critical fact. Perhaps use something like this: Sub ABC() Dim v1() As Long, v2() As Long ' Dummy code to generate ' two sorted arrays i = 1 j = 1 k = 1 For i = 1 To 100000 If Rnd() < 0.03 Then ReDim Preserve v1(1 To j) v1(j) = i j = j + 1 End If If Rnd() < 0.03 Then ReDim Preserve v2(1 To k) v2(k) = i k = k + 1 End If Next ' algorithm to check for match i = LBound(v1) j = LBound(v2) Do While i < UBound(v1) And j < UBound(v2) If v1(i) < v2(j) Then i = i + 1 ElseIf v2(j) < v1(i) Then j = j + 1 ElseIf v1(i) = v2(j) Then MsgBox "Match found at: " & vbNewLine & _ "v1(" & i & ")=" & v1(i) & vbNewLine & _ "v2(" & j & ")=" & v2(j) Exit Sub End If Loop MsgBox "Both have unique entries" End Sub -- Regards, Tom Ogilvy "RB Smissaert" wrote in message ... Will have a look at that. I am not interested in duplicates, but I need to know if there is a match and if so what the position is of the matching element in one of the arrays. Looking quickly at your code that should be possible. RBS "Jim Cone" wrote in message ... RBS, This demo code takes less than second to load and compare. Jim Cone San Francisco, USA '-------------------------------- Sub AreTheyTheSame() Dim colNumbers As VBA.Collection Dim arrOne() As String Dim arrTwo() As String Dim lngNum As Long Set colNumbers = New VBA.Collection ReDim arrOne(1 To 5000) ReDim arrTwo(1 To 10000) 'Load arrays For lngNum = 1 To 5000 arrOne(lngNum) = lngNum Next For lngNum = 1 To 10000 arrTwo(lngNum) = lngNum + 5000 Next 'Create a duplicate value arrTwo(10000) = 3000 'Load collection and check for duplicates For lngNum = 1 To UBound(arrOne) colNumbers.Add vbNullString, arrOne(lngNum) Next For lngNum = 1 To UBound(arrTwo) On Error Resume Next colNumbers.Add vbNullString, arrTwo(lngNum) If Err.Number = 457 Then MsgBox arrTwo(lngNum) & " is a duplicate. " Exit For End If Next Set colNumbers = Nothing End Sub'------------------------------------ "RB Smissaert" wrote in message ... Thanks, will have a look at both suggestions. Actually, I just found a way to speed this up, but that couldn't be seen from the way I put the question. Both arrays are variant arrays and I found I needed to do Val(array1element) = Val(array2element). This slows it up. If I make 2 new arrays re-dimmed with the same size, but now declared as long and transfer the values to compare to these new arrays and do the comparisons on that it speeds it up a lot. I started this routine with match, but found that a double loop was much faster. Will try again though. RBS |
Any way to do this faster?
By product of my method.
Will compare both Don't waste your time. Simple logic tells the tail. Just use Stephen's method if you understand that. -- Regards, Tom Ogilvy "RB Smissaert" wrote in message ... Will compare both, but I do need to match. I need to know the position of the element in array1 in array2. RBS "Tom Ogilvy" wrote in message ... Think you will find a binary search slower than what I have proposed. Particularly since you are trying not to match. -- Regards, Tom Ogilvy "RB Smissaert" wrote in message ... I got a reply about this off-list from Peter T and I think his suggestion was spot on. Use a binary search algorytyhm. This is in the book of Stephen Bullen, Professional Excel Development, which I have, so have used that and it speeds things up indeed. Thinking about it it was a bit silly to run the inner loop sequentially from LBound to UBound considering I knew both arrays were sorted. Will try your code as well though. RBS "Tom Ogilvy" wrote in message ... No it is completely different. I only use one Loop. -- Regards, Tom Ogilvy "RB Smissaert" wrote in message ... Thanks, will have a look at that as well. So this is a different way to walk the 2 arrays? This is the sequence as it is now, where RC1 and RC2 are the UBounds of the arrays. For r2 = 0 To RC2 - 1 For r1 = r1F To RC1 If arrNew1(r1) = arrNew2(r2) Then For c = 1 To CC2 arr3(r1, SC + c - 1) = arr2(r2, c) Next r1F = r1 + 1 Exit For End If If arrNew1(r1) arrNew2(r2) Then Exit For End If Next 'no point getting out early here Next This might actually be a similar idea as yours, although I haven't looked at it properly yet. RBS "Tom Ogilvy" wrote in message ... didn't you say the arrays are sorted? Both arrays are sorted ascending No one seems to take notice of this critical fact. Perhaps use something like this: Sub ABC() Dim v1() As Long, v2() As Long ' Dummy code to generate ' two sorted arrays i = 1 j = 1 k = 1 For i = 1 To 100000 If Rnd() < 0.03 Then ReDim Preserve v1(1 To j) v1(j) = i j = j + 1 End If If Rnd() < 0.03 Then ReDim Preserve v2(1 To k) v2(k) = i k = k + 1 End If Next ' algorithm to check for match i = LBound(v1) j = LBound(v2) Do While i < UBound(v1) And j < UBound(v2) If v1(i) < v2(j) Then i = i + 1 ElseIf v2(j) < v1(i) Then j = j + 1 ElseIf v1(i) = v2(j) Then MsgBox "Match found at: " & vbNewLine & _ "v1(" & i & ")=" & v1(i) & vbNewLine & _ "v2(" & j & ")=" & v2(j) Exit Sub End If Loop MsgBox "Both have unique entries" End Sub -- Regards, Tom Ogilvy "RB Smissaert" wrote in message ... Will have a look at that. I am not interested in duplicates, but I need to know if there is a match and if so what the position is of the matching element in one of the arrays. Looking quickly at your code that should be possible. RBS "Jim Cone" wrote in message ... RBS, This demo code takes less than second to load and compare. Jim Cone San Francisco, USA '-------------------------------- Sub AreTheyTheSame() Dim colNumbers As VBA.Collection Dim arrOne() As String Dim arrTwo() As String Dim lngNum As Long Set colNumbers = New VBA.Collection ReDim arrOne(1 To 5000) ReDim arrTwo(1 To 10000) 'Load arrays For lngNum = 1 To 5000 arrOne(lngNum) = lngNum Next For lngNum = 1 To 10000 arrTwo(lngNum) = lngNum + 5000 Next 'Create a duplicate value arrTwo(10000) = 3000 'Load collection and check for duplicates For lngNum = 1 To UBound(arrOne) colNumbers.Add vbNullString, arrOne(lngNum) Next For lngNum = 1 To UBound(arrTwo) On Error Resume Next colNumbers.Add vbNullString, arrTwo(lngNum) If Err.Number = 457 Then MsgBox arrTwo(lngNum) & " is a duplicate. " Exit For End If Next Set colNumbers = Nothing End Sub'------------------------------------ "RB Smissaert" wrote in message ... Thanks, will have a look at both suggestions. Actually, I just found a way to speed this up, but that couldn't be seen from the way I put the question. Both arrays are variant arrays and I found I needed to do Val(array1element) = Val(array2element). This slows it up. If I make 2 new arrays re-dimmed with the same size, but now declared as long and transfer the values to compare to these new arrays and do the comparisons on that it speeds it up a lot. I started this routine with match, but found that a double loop was much faster. Will try again though. RBS |
Any way to do this faster?
Of course Tail should be Tale <g. Must have been thinking of something
else. -- Regards, Tom Ogilvy "Tom Ogilvy" wrote in message ... By product of my method. Will compare both Don't waste your time. Simple logic tells the tail. Just use Stephen's method if you understand that. -- Regards, Tom Ogilvy "RB Smissaert" wrote in message ... Will compare both, but I do need to match. I need to know the position of the element in array1 in array2. RBS "Tom Ogilvy" wrote in message ... Think you will find a binary search slower than what I have proposed. Particularly since you are trying not to match. -- Regards, Tom Ogilvy "RB Smissaert" wrote in message ... I got a reply about this off-list from Peter T and I think his suggestion was spot on. Use a binary search algorytyhm. This is in the book of Stephen Bullen, Professional Excel Development, which I have, so have used that and it speeds things up indeed. Thinking about it it was a bit silly to run the inner loop sequentially from LBound to UBound considering I knew both arrays were sorted. Will try your code as well though. RBS "Tom Ogilvy" wrote in message ... No it is completely different. I only use one Loop. -- Regards, Tom Ogilvy "RB Smissaert" wrote in message ... Thanks, will have a look at that as well. So this is a different way to walk the 2 arrays? This is the sequence as it is now, where RC1 and RC2 are the UBounds of the arrays. For r2 = 0 To RC2 - 1 For r1 = r1F To RC1 If arrNew1(r1) = arrNew2(r2) Then For c = 1 To CC2 arr3(r1, SC + c - 1) = arr2(r2, c) Next r1F = r1 + 1 Exit For End If If arrNew1(r1) arrNew2(r2) Then Exit For End If Next 'no point getting out early here Next This might actually be a similar idea as yours, although I haven't looked at it properly yet. RBS "Tom Ogilvy" wrote in message ... didn't you say the arrays are sorted? Both arrays are sorted ascending No one seems to take notice of this critical fact. Perhaps use something like this: Sub ABC() Dim v1() As Long, v2() As Long ' Dummy code to generate ' two sorted arrays i = 1 j = 1 k = 1 For i = 1 To 100000 If Rnd() < 0.03 Then ReDim Preserve v1(1 To j) v1(j) = i j = j + 1 End If If Rnd() < 0.03 Then ReDim Preserve v2(1 To k) v2(k) = i k = k + 1 End If Next ' algorithm to check for match i = LBound(v1) j = LBound(v2) Do While i < UBound(v1) And j < UBound(v2) If v1(i) < v2(j) Then i = i + 1 ElseIf v2(j) < v1(i) Then j = j + 1 ElseIf v1(i) = v2(j) Then MsgBox "Match found at: " & vbNewLine & _ "v1(" & i & ")=" & v1(i) & vbNewLine & _ "v2(" & j & ")=" & v2(j) Exit Sub End If Loop MsgBox "Both have unique entries" End Sub -- Regards, Tom Ogilvy "RB Smissaert" wrote in message ... Will have a look at that. I am not interested in duplicates, but I need to know if there is a match and if so what the position is of the matching element in one of the arrays. Looking quickly at your code that should be possible. RBS "Jim Cone" wrote in message ... RBS, This demo code takes less than second to load and compare. Jim Cone San Francisco, USA '-------------------------------- Sub AreTheyTheSame() Dim colNumbers As VBA.Collection Dim arrOne() As String Dim arrTwo() As String Dim lngNum As Long Set colNumbers = New VBA.Collection ReDim arrOne(1 To 5000) ReDim arrTwo(1 To 10000) 'Load arrays For lngNum = 1 To 5000 arrOne(lngNum) = lngNum Next For lngNum = 1 To 10000 arrTwo(lngNum) = lngNum + 5000 Next 'Create a duplicate value arrTwo(10000) = 3000 'Load collection and check for duplicates For lngNum = 1 To UBound(arrOne) colNumbers.Add vbNullString, arrOne(lngNum) Next For lngNum = 1 To UBound(arrTwo) On Error Resume Next colNumbers.Add vbNullString, arrTwo(lngNum) If Err.Number = 457 Then MsgBox arrTwo(lngNum) & " is a duplicate. " Exit For End If Next Set colNumbers = Nothing End Sub'------------------------------------ "RB Smissaert" wrote in message ... Thanks, will have a look at both suggestions. Actually, I just found a way to speed this up, but that couldn't be seen from the way I put the question. Both arrays are variant arrays and I found I needed to do Val(array1element) = Val(array2element). This slows it up. If I make 2 new arrays re-dimmed with the same size, but now declared as long and transfer the values to compare to these new arrays and do the comparisons on that it speeds it up a lot. I started this routine with match, but found that a double loop was much faster. Will try again though. RBS |
Any way to do this faster?
Tom,
Have this tested now and you are right your method is indeed faster, particularly when there are no matches. Have worked it round a bit and this is what I have now. The Select Case bit can be ignored as that is my particular situation to cater for. Sub Matchup(ByRef arr1 As Variant, _ ByRef arr2 As Variant, _ ByRef arr3 As Variant, _ ByVal SC As Long, _ ByVal NodeType As Byte) 'arr1 is the list of ID numbers, 1-based array! 'arr2 is the lookup list, in this case NodeHoldingArray(NI), 0-based array! 'arr3 is the array where the matched up data goes, 1-based array! 'SC is the column where to start the added data in arr3 '--------------------------------------------------------------------------- Dim CC2 As Long Dim i As Long Dim j As Long Dim c As Long CC2 = UBound(arr2, 2) i = LBound(arr1) j = LBound(arr2) Do While i <= UBound(arr1) And j <= UBound(arr2) If arr1(i) < arr2(j, 0) Then i = i + 1 Else If arr2(j, 0) < arr1(i) Then j = j + 1 Else If arr1(i) = arr2(j, 0) Then 'found match, so copy to arr3 '---------------------------- Select Case NodeType Case 2 arr3(i, SC) = "NOT" Case 3 arr3(i, SC) = "yes" Case Else For c = 1 To CC2 arr3(i, SC + c - 1) = arr2(j, c) Next End Select i = i + 1 j = j + 1 End If End If End If Loop End Sub RBS "Tom Ogilvy" wrote in message ... Of course Tail should be Tale <g. Must have been thinking of something else. -- Regards, Tom Ogilvy "Tom Ogilvy" wrote in message ... By product of my method. Will compare both Don't waste your time. Simple logic tells the tail. Just use Stephen's method if you understand that. -- Regards, Tom Ogilvy "RB Smissaert" wrote in message ... Will compare both, but I do need to match. I need to know the position of the element in array1 in array2. RBS "Tom Ogilvy" wrote in message ... Think you will find a binary search slower than what I have proposed. Particularly since you are trying not to match. -- Regards, Tom Ogilvy "RB Smissaert" wrote in message ... I got a reply about this off-list from Peter T and I think his suggestion was spot on. Use a binary search algorytyhm. This is in the book of Stephen Bullen, Professional Excel Development, which I have, so have used that and it speeds things up indeed. Thinking about it it was a bit silly to run the inner loop sequentially from LBound to UBound considering I knew both arrays were sorted. Will try your code as well though. RBS "Tom Ogilvy" wrote in message ... No it is completely different. I only use one Loop. -- Regards, Tom Ogilvy "RB Smissaert" wrote in message ... Thanks, will have a look at that as well. So this is a different way to walk the 2 arrays? This is the sequence as it is now, where RC1 and RC2 are the UBounds of the arrays. For r2 = 0 To RC2 - 1 For r1 = r1F To RC1 If arrNew1(r1) = arrNew2(r2) Then For c = 1 To CC2 arr3(r1, SC + c - 1) = arr2(r2, c) Next r1F = r1 + 1 Exit For End If If arrNew1(r1) arrNew2(r2) Then Exit For End If Next 'no point getting out early here Next This might actually be a similar idea as yours, although I haven't looked at it properly yet. RBS "Tom Ogilvy" wrote in message ... didn't you say the arrays are sorted? Both arrays are sorted ascending No one seems to take notice of this critical fact. Perhaps use something like this: Sub ABC() Dim v1() As Long, v2() As Long ' Dummy code to generate ' two sorted arrays i = 1 j = 1 k = 1 For i = 1 To 100000 If Rnd() < 0.03 Then ReDim Preserve v1(1 To j) v1(j) = i j = j + 1 End If If Rnd() < 0.03 Then ReDim Preserve v2(1 To k) v2(k) = i k = k + 1 End If Next ' algorithm to check for match i = LBound(v1) j = LBound(v2) Do While i < UBound(v1) And j < UBound(v2) If v1(i) < v2(j) Then i = i + 1 ElseIf v2(j) < v1(i) Then j = j + 1 ElseIf v1(i) = v2(j) Then MsgBox "Match found at: " & vbNewLine & _ "v1(" & i & ")=" & v1(i) & vbNewLine & _ "v2(" & j & ")=" & v2(j) Exit Sub End If Loop MsgBox "Both have unique entries" End Sub -- Regards, Tom Ogilvy "RB Smissaert" wrote in message ... Will have a look at that. I am not interested in duplicates, but I need to know if there is a match and if so what the position is of the matching element in one of the arrays. Looking quickly at your code that should be possible. RBS "Jim Cone" wrote in message ... RBS, This demo code takes less than second to load and compare. Jim Cone San Francisco, USA '-------------------------------- Sub AreTheyTheSame() Dim colNumbers As VBA.Collection Dim arrOne() As String Dim arrTwo() As String Dim lngNum As Long Set colNumbers = New VBA.Collection ReDim arrOne(1 To 5000) ReDim arrTwo(1 To 10000) 'Load arrays For lngNum = 1 To 5000 arrOne(lngNum) = lngNum Next For lngNum = 1 To 10000 arrTwo(lngNum) = lngNum + 5000 Next 'Create a duplicate value arrTwo(10000) = 3000 'Load collection and check for duplicates For lngNum = 1 To UBound(arrOne) colNumbers.Add vbNullString, arrOne(lngNum) Next For lngNum = 1 To UBound(arrTwo) On Error Resume Next colNumbers.Add vbNullString, arrTwo(lngNum) If Err.Number = 457 Then MsgBox arrTwo(lngNum) & " is a duplicate. " Exit For End If Next Set colNumbers = Nothing End Sub'------------------------------------ "RB Smissaert" wrote in message ... Thanks, will have a look at both suggestions. Actually, I just found a way to speed this up, but that couldn't be seen from the way I put the question. Both arrays are variant arrays and I found I needed to do Val(array1element) = Val(array2element). This slows it up. If I make 2 new arrays re-dimmed with the same size, but now declared as long and transfer the values to compare to these new arrays and do the comparisons on that it speeds it up a lot. I started this routine with match, but found that a double loop was much faster. Will try again though. RBS |
Any way to do this faster?
I think this is how it should be if I make it generic:
Sub Matchup(ByRef arr1 As Variant, _ ByRef arr2 As Variant) Dim i As Long Dim j As Long i = LBound(arr1) j = LBound(arr2) Do While i <= UBound(arr1) And j <= UBound(arr2) If arr1(i) = arr2(j) Then 'found match, so do whatever needs doing '--------------------------------------- i = i + 1 j = j + 1 Else If arr2(j) < arr1(i) Then j = j + 1 Else If arr1(i) < arr2(j) Then i = i + 1 End If End If End If Loop End Sub This will catch matches at both ends of both arrays, which your original code didn't do. Nice bit of code and thanks again for the tip. RBS "Tom Ogilvy" wrote in message ... By product of my method. Will compare both Don't waste your time. Simple logic tells the tail. Just use Stephen's method if you understand that. -- Regards, Tom Ogilvy "RB Smissaert" wrote in message ... Will compare both, but I do need to match. I need to know the position of the element in array1 in array2. RBS "Tom Ogilvy" wrote in message ... Think you will find a binary search slower than what I have proposed. Particularly since you are trying not to match. -- Regards, Tom Ogilvy "RB Smissaert" wrote in message ... I got a reply about this off-list from Peter T and I think his suggestion was spot on. Use a binary search algorytyhm. This is in the book of Stephen Bullen, Professional Excel Development, which I have, so have used that and it speeds things up indeed. Thinking about it it was a bit silly to run the inner loop sequentially from LBound to UBound considering I knew both arrays were sorted. Will try your code as well though. RBS "Tom Ogilvy" wrote in message ... No it is completely different. I only use one Loop. -- Regards, Tom Ogilvy "RB Smissaert" wrote in message ... Thanks, will have a look at that as well. So this is a different way to walk the 2 arrays? This is the sequence as it is now, where RC1 and RC2 are the UBounds of the arrays. For r2 = 0 To RC2 - 1 For r1 = r1F To RC1 If arrNew1(r1) = arrNew2(r2) Then For c = 1 To CC2 arr3(r1, SC + c - 1) = arr2(r2, c) Next r1F = r1 + 1 Exit For End If If arrNew1(r1) arrNew2(r2) Then Exit For End If Next 'no point getting out early here Next This might actually be a similar idea as yours, although I haven't looked at it properly yet. RBS "Tom Ogilvy" wrote in message ... didn't you say the arrays are sorted? Both arrays are sorted ascending No one seems to take notice of this critical fact. Perhaps use something like this: Sub ABC() Dim v1() As Long, v2() As Long ' Dummy code to generate ' two sorted arrays i = 1 j = 1 k = 1 For i = 1 To 100000 If Rnd() < 0.03 Then ReDim Preserve v1(1 To j) v1(j) = i j = j + 1 End If If Rnd() < 0.03 Then ReDim Preserve v2(1 To k) v2(k) = i k = k + 1 End If Next ' algorithm to check for match i = LBound(v1) j = LBound(v2) Do While i < UBound(v1) And j < UBound(v2) If v1(i) < v2(j) Then i = i + 1 ElseIf v2(j) < v1(i) Then j = j + 1 ElseIf v1(i) = v2(j) Then MsgBox "Match found at: " & vbNewLine & _ "v1(" & i & ")=" & v1(i) & vbNewLine & _ "v2(" & j & ")=" & v2(j) Exit Sub End If Loop MsgBox "Both have unique entries" End Sub -- Regards, Tom Ogilvy "RB Smissaert" wrote in message ... Will have a look at that. I am not interested in duplicates, but I need to know if there is a match and if so what the position is of the matching element in one of the arrays. Looking quickly at your code that should be possible. RBS "Jim Cone" wrote in message ... RBS, This demo code takes less than second to load and compare. Jim Cone San Francisco, USA '-------------------------------- Sub AreTheyTheSame() Dim colNumbers As VBA.Collection Dim arrOne() As String Dim arrTwo() As String Dim lngNum As Long Set colNumbers = New VBA.Collection ReDim arrOne(1 To 5000) ReDim arrTwo(1 To 10000) 'Load arrays For lngNum = 1 To 5000 arrOne(lngNum) = lngNum Next For lngNum = 1 To 10000 arrTwo(lngNum) = lngNum + 5000 Next 'Create a duplicate value arrTwo(10000) = 3000 'Load collection and check for duplicates For lngNum = 1 To UBound(arrOne) colNumbers.Add vbNullString, arrOne(lngNum) Next For lngNum = 1 To UBound(arrTwo) On Error Resume Next colNumbers.Add vbNullString, arrTwo(lngNum) If Err.Number = 457 Then MsgBox arrTwo(lngNum) & " is a duplicate. " Exit For End If Next Set colNumbers = Nothing End Sub'------------------------------------ "RB Smissaert" wrote in message ... Thanks, will have a look at both suggestions. Actually, I just found a way to speed this up, but that couldn't be seen from the way I put the question. Both arrays are variant arrays and I found I needed to do Val(array1element) = Val(array2element). This slows it up. If I make 2 new arrays re-dimmed with the same size, but now declared as long and transfer the values to compare to these new arrays and do the comparisons on that it speeds it up a lot. I started this routine with match, but found that a double loop was much faster. Will try again though. RBS |
Any way to do this faster?
I agree that the While loop should be <= but you were looking for reasons
not to us it, so I never got around to saying that. My code was for 1 based arrays and did check the first values. It was provided to be illustrative, not a turnkey solution. -- Regards, Tom Ogilvy "RB Smissaert" wrote in message ... I think this is how it should be if I make it generic: Sub Matchup(ByRef arr1 As Variant, _ ByRef arr2 As Variant) Dim i As Long Dim j As Long i = LBound(arr1) j = LBound(arr2) Do While i <= UBound(arr1) And j <= UBound(arr2) If arr1(i) = arr2(j) Then 'found match, so do whatever needs doing '--------------------------------------- i = i + 1 j = j + 1 Else If arr2(j) < arr1(i) Then j = j + 1 Else If arr1(i) < arr2(j) Then i = i + 1 End If End If End If Loop End Sub This will catch matches at both ends of both arrays, which your original code didn't do. Nice bit of code and thanks again for the tip. RBS "Tom Ogilvy" wrote in message ... By product of my method. Will compare both Don't waste your time. Simple logic tells the tail. Just use Stephen's method if you understand that. -- Regards, Tom Ogilvy "RB Smissaert" wrote in message ... Will compare both, but I do need to match. I need to know the position of the element in array1 in array2. RBS "Tom Ogilvy" wrote in message ... Think you will find a binary search slower than what I have proposed. Particularly since you are trying not to match. -- Regards, Tom Ogilvy "RB Smissaert" wrote in message ... I got a reply about this off-list from Peter T and I think his suggestion was spot on. Use a binary search algorytyhm. This is in the book of Stephen Bullen, Professional Excel Development, which I have, so have used that and it speeds things up indeed. Thinking about it it was a bit silly to run the inner loop sequentially from LBound to UBound considering I knew both arrays were sorted. Will try your code as well though. RBS "Tom Ogilvy" wrote in message ... No it is completely different. I only use one Loop. -- Regards, Tom Ogilvy "RB Smissaert" wrote in message ... Thanks, will have a look at that as well. So this is a different way to walk the 2 arrays? This is the sequence as it is now, where RC1 and RC2 are the UBounds of the arrays. For r2 = 0 To RC2 - 1 For r1 = r1F To RC1 If arrNew1(r1) = arrNew2(r2) Then For c = 1 To CC2 arr3(r1, SC + c - 1) = arr2(r2, c) Next r1F = r1 + 1 Exit For End If If arrNew1(r1) arrNew2(r2) Then Exit For End If Next 'no point getting out early here Next This might actually be a similar idea as yours, although I haven't looked at it properly yet. RBS "Tom Ogilvy" wrote in message ... didn't you say the arrays are sorted? Both arrays are sorted ascending No one seems to take notice of this critical fact. Perhaps use something like this: Sub ABC() Dim v1() As Long, v2() As Long ' Dummy code to generate ' two sorted arrays i = 1 j = 1 k = 1 For i = 1 To 100000 If Rnd() < 0.03 Then ReDim Preserve v1(1 To j) v1(j) = i j = j + 1 End If If Rnd() < 0.03 Then ReDim Preserve v2(1 To k) v2(k) = i k = k + 1 End If Next ' algorithm to check for match i = LBound(v1) j = LBound(v2) Do While i < UBound(v1) And j < UBound(v2) If v1(i) < v2(j) Then i = i + 1 ElseIf v2(j) < v1(i) Then j = j + 1 ElseIf v1(i) = v2(j) Then MsgBox "Match found at: " & vbNewLine & _ "v1(" & i & ")=" & v1(i) & vbNewLine & _ "v2(" & j & ")=" & v2(j) Exit Sub End If Loop MsgBox "Both have unique entries" End Sub -- Regards, Tom Ogilvy "RB Smissaert" wrote in message ... Will have a look at that. I am not interested in duplicates, but I need to know if there is a match and if so what the position is of the matching element in one of the arrays. Looking quickly at your code that should be possible. RBS "Jim Cone" wrote in message ... RBS, This demo code takes less than second to load and compare. Jim Cone San Francisco, USA '-------------------------------- Sub AreTheyTheSame() Dim colNumbers As VBA.Collection Dim arrOne() As String Dim arrTwo() As String Dim lngNum As Long Set colNumbers = New VBA.Collection ReDim arrOne(1 To 5000) ReDim arrTwo(1 To 10000) 'Load arrays For lngNum = 1 To 5000 arrOne(lngNum) = lngNum Next For lngNum = 1 To 10000 arrTwo(lngNum) = lngNum + 5000 Next 'Create a duplicate value arrTwo(10000) = 3000 'Load collection and check for duplicates For lngNum = 1 To UBound(arrOne) colNumbers.Add vbNullString, arrOne(lngNum) Next For lngNum = 1 To UBound(arrTwo) On Error Resume Next colNumbers.Add vbNullString, arrTwo(lngNum) If Err.Number = 457 Then MsgBox arrTwo(lngNum) & " is a duplicate. " Exit For End If Next Set colNumbers = Nothing End Sub'------------------------------------ "RB Smissaert" wrote in message ... Thanks, will have a look at both suggestions. Actually, I just found a way to speed this up, but that couldn't be seen from the way I put the question. Both arrays are variant arrays and I found I needed to do Val(array1element) = Val(array2element). This slows it up. If I make 2 new arrays re-dimmed with the same size, but now declared as long and transfer the values to compare to these new arrays and do the comparisons on that it speeds it up a lot. I started this routine with match, but found that a double loop was much faster. Will try again though. RBS |
Any way to do this faster?
you were looking for reasons not to us it
Well, I am using it now and I am grateful for your code. Simple, elegant and much faster. There are probably much more places in my app where I can use it as I often have to matchup 2 arrays. RBS "Tom Ogilvy" wrote in message ... I agree that the While loop should be <= but you were looking for reasons not to us it, so I never got around to saying that. My code was for 1 based arrays and did check the first values. It was provided to be illustrative, not a turnkey solution. -- Regards, Tom Ogilvy "RB Smissaert" wrote in message ... I think this is how it should be if I make it generic: Sub Matchup(ByRef arr1 As Variant, _ ByRef arr2 As Variant) Dim i As Long Dim j As Long i = LBound(arr1) j = LBound(arr2) Do While i <= UBound(arr1) And j <= UBound(arr2) If arr1(i) = arr2(j) Then 'found match, so do whatever needs doing '--------------------------------------- i = i + 1 j = j + 1 Else If arr2(j) < arr1(i) Then j = j + 1 Else If arr1(i) < arr2(j) Then i = i + 1 End If End If End If Loop End Sub This will catch matches at both ends of both arrays, which your original code didn't do. Nice bit of code and thanks again for the tip. RBS "Tom Ogilvy" wrote in message ... By product of my method. Will compare both Don't waste your time. Simple logic tells the tail. Just use Stephen's method if you understand that. -- Regards, Tom Ogilvy "RB Smissaert" wrote in message ... Will compare both, but I do need to match. I need to know the position of the element in array1 in array2. RBS "Tom Ogilvy" wrote in message ... Think you will find a binary search slower than what I have proposed. Particularly since you are trying not to match. -- Regards, Tom Ogilvy "RB Smissaert" wrote in message ... I got a reply about this off-list from Peter T and I think his suggestion was spot on. Use a binary search algorytyhm. This is in the book of Stephen Bullen, Professional Excel Development, which I have, so have used that and it speeds things up indeed. Thinking about it it was a bit silly to run the inner loop sequentially from LBound to UBound considering I knew both arrays were sorted. Will try your code as well though. RBS "Tom Ogilvy" wrote in message ... No it is completely different. I only use one Loop. -- Regards, Tom Ogilvy "RB Smissaert" wrote in message ... Thanks, will have a look at that as well. So this is a different way to walk the 2 arrays? This is the sequence as it is now, where RC1 and RC2 are the UBounds of the arrays. For r2 = 0 To RC2 - 1 For r1 = r1F To RC1 If arrNew1(r1) = arrNew2(r2) Then For c = 1 To CC2 arr3(r1, SC + c - 1) = arr2(r2, c) Next r1F = r1 + 1 Exit For End If If arrNew1(r1) arrNew2(r2) Then Exit For End If Next 'no point getting out early here Next This might actually be a similar idea as yours, although I haven't looked at it properly yet. RBS "Tom Ogilvy" wrote in message ... didn't you say the arrays are sorted? Both arrays are sorted ascending No one seems to take notice of this critical fact. Perhaps use something like this: Sub ABC() Dim v1() As Long, v2() As Long ' Dummy code to generate ' two sorted arrays i = 1 j = 1 k = 1 For i = 1 To 100000 If Rnd() < 0.03 Then ReDim Preserve v1(1 To j) v1(j) = i j = j + 1 End If If Rnd() < 0.03 Then ReDim Preserve v2(1 To k) v2(k) = i k = k + 1 End If Next ' algorithm to check for match i = LBound(v1) j = LBound(v2) Do While i < UBound(v1) And j < UBound(v2) If v1(i) < v2(j) Then i = i + 1 ElseIf v2(j) < v1(i) Then j = j + 1 ElseIf v1(i) = v2(j) Then MsgBox "Match found at: " & vbNewLine & _ "v1(" & i & ")=" & v1(i) & vbNewLine & _ "v2(" & j & ")=" & v2(j) Exit Sub End If Loop MsgBox "Both have unique entries" End Sub -- Regards, Tom Ogilvy "RB Smissaert" wrote in message ... Will have a look at that. I am not interested in duplicates, but I need to know if there is a match and if so what the position is of the matching element in one of the arrays. Looking quickly at your code that should be possible. RBS "Jim Cone" wrote in message ... RBS, This demo code takes less than second to load and compare. Jim Cone San Francisco, USA '-------------------------------- Sub AreTheyTheSame() Dim colNumbers As VBA.Collection Dim arrOne() As String Dim arrTwo() As String Dim lngNum As Long Set colNumbers = New VBA.Collection ReDim arrOne(1 To 5000) ReDim arrTwo(1 To 10000) 'Load arrays For lngNum = 1 To 5000 arrOne(lngNum) = lngNum Next For lngNum = 1 To 10000 arrTwo(lngNum) = lngNum + 5000 Next 'Create a duplicate value arrTwo(10000) = 3000 'Load collection and check for duplicates For lngNum = 1 To UBound(arrOne) colNumbers.Add vbNullString, arrOne(lngNum) Next For lngNum = 1 To UBound(arrTwo) On Error Resume Next colNumbers.Add vbNullString, arrTwo(lngNum) If Err.Number = 457 Then MsgBox arrTwo(lngNum) & " is a duplicate. " Exit For End If Next Set colNumbers = Nothing End Sub'------------------------------------ "RB Smissaert" wrote in message ... Thanks, will have a look at both suggestions. Actually, I just found a way to speed this up, but that couldn't be seen from the way I put the question. Both arrays are variant arrays and I found I needed to do Val(array1element) = Val(array2element). This slows it up. If I make 2 new arrays re-dimmed with the same size, but now declared as long and transfer the values to compare to these new arrays and do the comparisons on that it speeds it up a lot. I started this routine with match, but found that a double loop was much faster. Will try again though. RBS |
All times are GMT +1. The time now is 03:40 PM. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com