• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

VBA run a Loop into another Loop [SOLVED]

Dear friends,


I have a macro that seems to work perfectly when testing. However it stuck when I move it to a real word (more than thousand row data). The purpose of this code is to compare to different sheets and make some calculation when the search match. The problem is each sheet has more than 10 thousand rows and I need to concatenate 4 columns to create a unique string to compare.

It seems that doing this I have more than 1 billion loops. My Question: What am I doing wrong here? How to have the same result using a faster way?


Thanks in advance

Mota

*****

[pre]
Code:
lRow = Sheet2.Range("A" & Rows.Count).End(xlUp).Row
nRow = Sheet1.Range("B" & Rows.Count).End(xlUp).Row

For n = 2 To nRow
For y = 1 To 4
Result1 = Result1 & Sheet1.Cells(n, y)
Next y

For i = 2 To lRow
For j = 1 To 4
Result2 = Result2 & Sheet2.Cells(i, j)
Next j
If Result1 = Result2 Then
Sheet1.Range("E" & n) = "Test"
Sheet1.Range("F" & n) = Sheet2.Range("E" & i) + 7
End If
Result2 = ""
Next i
Result1 = ""
Next n
[/pre]
 
This section appears questionable. See comments

[pre]
Code:
If Result1 = Result2 Then
'I don't understand this part. We're looping through i
'but all the output here will be to the same cell Fn
'Why the multiple writes? If this will only happen once
'you should add an
'Exit For
'at the end
Sheet1.Range("E" & n) = "Test"
Sheet1.Range("F" & n) = Sheet2.Range("E" & i) + 7
End If
[/pre]
 
Great observation Luke. Thanks!

Save a lot of time. But the code is still taking long time to cover whole sheet. Any other idea will be very welcome.

Thanks

***

[pre]
Code:
lRow = Sheet2.Range("A" & Rows.Count).End(xlUp).Row
nRow = Sheet1.Range("B" & Rows.Count).End(xlUp).Row

For n = 2 To nRow
For y = 1 To 4
Result1 = Result1 & Sheet1.Cells(n, y)
Next y

For i = 2 To lRow
For j = 1 To 4
Result2 = Result2 & Sheet2.Cells(i, j)
Next j
If Result1 = Result2 Then
Sheet1.Range("E" & n) = "Teste"
Sheet1.Range("F" & n) = Sheet2.Range("E" & i) + 7
Exit For
End If
Result2 = ""
Next i
Result1 = ""
Next n
[/pre]
 
Hi Motabrasil..


Lil bit confused in a single line.. but I think you can manage.. here is the rest of the part.. Please adjust if required.. :p

[pre]
Code:
Sub test()
lrow = Sheet2.Range("A" & Rows.Count).End(xlUp).Row
nrow = Sheet1.Range("B" & Rows.Count).End(xlUp).Row

If Evaluate("=AND(Sheet1!B2:B" & nrow & "=Sheet2!A2:A" & lrow & ")") Then
Sheet1.Range("E2:E" & nrow) = "Teste"
'Please help.. in normal langulage.. value for F2..
'Sheet1.Range("F" & n) = Sheet2.Range("E" & i) + 7
End If
End Sub
[/pre]

Please let us know the speed improvement..


Regards,

Deb
 
Hi,


Can You sort the columns A and B and use strComp to skip unessary test!?

or this option is slow also!?

some think like this algorithm:

[pre]
Code:
while (n <= nRow) {
Res1 = ...;
while (l <= lRow){
Res2 = ...;
c = strComp(Res1, Res2);
if ( c < 0)
{
l = l+ 1;
continue; // look for the next Res2
}
else if (c = 0)
{
E = ...; // we have a mutch
F = ...;
break;
}
else
{
break; // look for the next Res1
}
}
n = n +1;
}
[/pre]
 
@Deb


I like the use of Evaluate, but this changes the macro's intent. As originally written, it goes through a list of 4 column on Sheet1 and looks for a similar concatenation on Sheet2. If it finds one, marks it with "test".


Notes:

Possible to have multiple entries on Sheet1 that need marks

Possible to not find any matching combos on Sheet2 (this leads to longest possible loop

Not sure if does happen, but possible for sheet1 to have:

Code:
ca   t   d   og

and sheet2 to have

c    at  do   g

and technically, this should count as a match since the concatenation is the same. Would need the OP to clarify if this scenario needs to be checked for, or is it simply "do these 4 cells match these 4 cells?"
 
There's probably an equivalent using only VB, but I'd suggest using a helper column in sheet2 to do your concatenation. This seems to run at a decent speed for ~3000 rows. Could get even faster if a similar helper column was made for Sheet1.

[pre]
Code:
Sub SomeSub()
Dim lRow As Long
Dim nRow As Long
Dim Result1 As String
Dim fCell As Range

lRow = Sheet2.Range("A" & Rows.Count).End(xlUp).Row
nRow = Sheet1.Range("B" & Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False
For n = 2 To nRow
For y = 1 To 4
Result1 = Result1 & Sheet1.Cells(n, y)
Next y

'Assume helper cells in col Z with formula
'=A2&B2&C2&D2

Set fCell = Sheet2.Range("Z:Z").Find(what:=Result1, LookIn:=xlValues, lookat:=xlWhole)

If fCell Is Nothing Then
'Cell not found, don't mark it
Else
Sheet1.Range("E" & n) = "Test"
Sheet1.Range("F" & n) = Sheet2.Range("E" & fCell.Row) + 7
End If
Result1 = ""
Next n
Application.ScreenUpdating = True
End Sub
[/pre]
 
Thanks Luke.. I re-read the code.. and looks similar to your explanation..


with a hope.. let the OP speak.. :)


Regards,

Deb
 
I created the "helper" column and concatenated one sheet as suggested.

It worked great!!!!! Reduced thousand of loops doing this.


Thanks Guys!!!

You saved my day.
 
This post is solved. Yet I'd like to chip in as I think the best method would be to use Computer's memory. In above case, should not matter even if we are looking at billion loops as long as we are not interacting with ranges. If we use Arrays then it will be fast.


Please test this method. It should be considerably faster as it doesn't deal with ranges in the loop and uses Index based array handling object.


It takes 1 sec to process 10 thousand rows.

[pre]
Code:
Option Explicit
Sub FindMatches()
Dim varCheck As Variant, varSource As Variant
Dim objDic As Object
Dim strVal As String
Dim i As Long

'Load items into array from worksheets
varCheck = Sheet1.Range("A2:F" & Sheet1.Range("A" & Rows.Count).End(xlUp).Row).Value
varSource = Sheet2.Range("A2:E" & Sheet2.Range("A" & Rows.Count).End(xlUp).Row).Value

'Build up the basic list to check against using dictionary object
Set objDic = CreateObject("Scripting.Dictionary")

For i = LBound(varSource) To UBound(varSource)
strVal = varSource(i, 1) & varSource(i, 2) & varSource(i, 3) & varSource(i, 4)
If Not objDic.exists(strVal) Then
objDic.Add strVal, varSource(i, 5)
End If
Next i

'Finally Check the strings for existence
For i = LBound(varCheck) To UBound(varCheck)
strVal = varCheck(i, 1) & varCheck(i, 2) & varCheck(i, 3) & varCheck(i, 4)
If objDic.exists(strVal) Then
varCheck(i, 5) = "Test"
varCheck(i, 6) = CDec(objDic.Item(strVal)) + 7
Else
varCheck(i, 5) = ""
varCheck(i, 6) = ""
End If
Next i

'Load the values back to worksheet
Sheet1.Range("A2:F" & Sheet1.Range("A" & Rows.Count).End(xlUp).Row).Value = varCheck

End Sub
[/pre]
 
@shrivallabha, very good code!! but...in this line:

[pre]
Code:
'Load the values back to worksheet
Sheet1.Range("A2:F" & Sheet1.Range("A" & Rows.Count).End(xlUp).Row).Value = varCheck
[/pre]
only 2 columns need to be written not 6.

And I think "objDic.Add" methode involve (hash and comparison) that we can avoid if we have a helper column(s) sorted.
 
I just use one array so didn't want to manipulate to get last 2 col data. It shouldn't affect anything. I did that way so as not to use any helper columns or more arrays and manipulation ;)


Using helper columns is great idea and then whole concept can also be implemented using formulas and we should not need any VBA at all.


Alternatively a formula like this can be used if you want to avoid helper columns.

=IF(SUM(--ISNUMBER(MATCH(A2&B2&C2&D2,Sheet2!$A$2:$A$10001&Sheet2!$B$2:$B$10001&Sheet2!$C$2:$C$10001&Sheet2!$D$2:$D$10001,0)))>0,"Test","")

It is array formula which needs to be implemented using CSE.
 
I agree, shrivallabha...using a dictionary is a very good approach. If anyone's interested, there's an excellent tutorial on dictionaries at http://www.experts-exchange.com/Software/Office_Productivity/Office_Suites/MS_Office/A_3391-Using-the-Dictionary-Class-in-VBA.html


I used something similar as per the above to solve a question at http://www.excelguru.ca/forums/showthread.php?1792-VBA-Program-to-Compare-4-Columns-in-Excel-%28Required%29 and that code might be of further interest. Basically I use two dictionaries to check for duplicates across any number of columns.
 
@shrivallabha

Beautiful work my friend. I will save this for study...I knew there had a to be a better way to do it using VBA.
 
Back
Top