VBA run a Loop into another Loop [SOLVED]

motabrasil · Jun 21, 2013

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(&#34;A&#34; & Rows.Count).End(xlUp).Row
nRow = Sheet1.Range(&#34;B&#34; & 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(&#34;E&#34; & n) = &#34;Test&#34;
Sheet1.Range(&#34;F&#34; & n) = Sheet2.Range(&#34;E&#34; & i) + 7
End If
Result2 = &#34;&#34;
Next i
Result1 = &#34;&#34;
Next n

[/pre]

Luke M · Jun 21, 2013

This section appears questionable. See comments

[pre]

Code:

If Result1 = Result2 Then
&#39;I don&#39;t understand this part. We&#39;re looping through i
&#39;but all the output here will be to the same cell Fn
&#39;Why the multiple writes? If this will only happen once
&#39;you should add an
&#39;Exit For
&#39;at the end
Sheet1.Range(&#34;E&#34; & n) = &#34;Test&#34;
Sheet1.Range(&#34;F&#34; & n) = Sheet2.Range(&#34;E&#34; & i) + 7
End If

[/pre]

motabrasil · Jun 21, 2013

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(&#34;A&#34; & Rows.Count).End(xlUp).Row
nRow = Sheet1.Range(&#34;B&#34; & 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(&#34;E&#34; & n) = &#34;Teste&#34;
Sheet1.Range(&#34;F&#34; & n) = Sheet2.Range(&#34;E&#34; & i) + 7
Exit For
End If
Result2 = &#34;&#34;
Next i
Result1 = &#34;&#34;
Next n

[/pre]

Debraj · Jun 21, 2013

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..

[pre]

Code:

Sub test()
lrow = Sheet2.Range(&#34;A&#34; & Rows.Count).End(xlUp).Row
nrow = Sheet1.Range(&#34;B&#34; & Rows.Count).End(xlUp).Row

If Evaluate(&#34;=AND(Sheet1!B2:B&#34; & nrow & &#34;=Sheet2!A2:A&#34; & lrow & &#34;)&#34;) Then
Sheet1.Range(&#34;E2:E&#34; & nrow) = &#34;Teste&#34;
&#39;Please help.. in normal langulage.. value for F2..
&#39;Sheet1.Range(&#34;F&#34; & n) = Sheet2.Range(&#34;E&#34; & i) + 7
End If
End Sub

[/pre]

Please let us know the speed improvement..

Regards,

Deb

imla · Jun 21, 2013

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 &#60;= nRow) {
Res1 = ...;
while (l &#60;= lRow){
Res2 = ...;
c = strComp(Res1, Res2);
if ( c &#60; 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]

Luke M · Jun 21, 2013

@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?"

Luke M · Jun 21, 2013

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(&#34;A&#34; & Rows.Count).End(xlUp).Row
nRow = Sheet1.Range(&#34;B&#34; & 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

&#39;Assume helper cells in col Z with formula
&#39;=A2&B2&C2&D2

Set fCell = Sheet2.Range(&#34;Z:Z&#34;).Find(what:=Result1, LookIn:=xlValues, lookat:=xlWhole)

If fCell Is Nothing Then
&#39;Cell not found, don&#39;t mark it
Else
Sheet1.Range(&#34;E&#34; & n) = &#34;Test&#34;
Sheet1.Range(&#34;F&#34; & n) = Sheet2.Range(&#34;E&#34; & fCell.Row) + 7
End If
Result1 = &#34;&#34;
Next n
Application.ScreenUpdating = True
End Sub

[/pre]

Debraj · Jun 21, 2013

Thanks Luke.. I re-read the code.. and looks similar to your explanation..

with a hope.. let the OP speak..

Regards,

Deb

motabrasil · Jun 21, 2013

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.

Luke M · Jun 21, 2013

Terrific, glad we could help, and thanks for the feedback.

shrivallabha · Jun 22, 2013

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

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

&#39;Build up the basic list to check against using dictionary object
Set objDic = CreateObject(&#34;Scripting.Dictionary&#34;)

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

&#39;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) = &#34;Test&#34;
varCheck(i, 6) = CDec(objDic.Item(strVal)) + 7
Else
varCheck(i, 5) = &#34;&#34;
varCheck(i, 6) = &#34;&#34;
End If
Next i

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

End Sub

[/pre]

imla · Jun 22, 2013

@shrivallabha, very good code!! but...in this line:

[pre]

Code:

&#39;Load the values back to worksheet
Sheet1.Range(&#34;A2:F&#34; & Sheet1.Range(&#34;A&#34; & 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.

shrivallabha · Jun 22, 2013

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.

jeffreyweir · Jun 23, 2013

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.

Luke M · Jun 24, 2013

@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.

VBA run a Loop into another Loop [SOLVED]

motabrasil

Member

Luke M

Excel Ninja

motabrasil

Member

Debraj

Excel Ninja

imla

Member

Luke M

Excel Ninja

Luke M

Excel Ninja

Debraj

Excel Ninja

motabrasil

Member

Luke M

Excel Ninja

shrivallabha

Excel Ninja

imla

Member

shrivallabha

Excel Ninja

jeffreyweir

Active Member

Luke M

Excel Ninja