PDA

View Full Version : [SOLVED] need help gettng macro to run faster! please!!!



estatefinds
08-02-2017, 11:27 AM
this current macro runs over 12 minutes. i had added some code to help with it but not improving much.
any help on this is much Appreciated!
Thank you in advance!
Sincerely Dennis


Sub mySearch()
Dim colAO As Range
Dim colAN As Range
Dim DataTable As Range
Dim Found As Range
Dim Location As Variant
Dim rw As Long
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Set colH = Range("AO:AO")
Set colAN = Range("AN:AN")
Set DataTable = Range(Range("E1"), Cells(Rows.Count, "AL").End(xlUp))

For rw = 1 To Cells(Rows.Count, "AN").End(xlUp).Row
With colH
If IsEmpty(.Cells(rw)) Then
Set Found = DataTable.Find(colAN.Cells(rw))
If Found Is Nothing Then
.Cells(rw) = "#NA"
Else
Location = Split(Found.Address, "$")
.Cells(rw) = Location(2) & "-" & Location(1)
End If
End If
End With
Set Found = Nothing
Next
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.DisplayStatusBar = True
Application.EnableEvents = True

Fennek
08-02-2017, 11:53 AM
Hello,

to search in AO:AO, i.e. in 1 mio rows, might not very efficient.

Instead of "IsEmpty" the function "specialcells(xlblankcells)" could be better.

Maybe the best is, to upload the file with a description of the goal, then someone can write a code from scratch.

regardss

SamT
08-02-2017, 12:49 PM
The problem is that he never told us in which column of the datatable the searched for value would be found, so we had to search the entire table.

As you noticed, he declared the Variable colAO, but he is using the variable colH to hold the Range("AO:AO")

Fennek
08-02-2017, 01:09 PM
Hello,

after rechecking this is my proposal:



Sub iFen()
Dim Res()
Ar = Range(Range("E1"), Cells(Rows.Count, "AL").End(xlUp))
With CreateObject("scripting.dictionary")
lr = Cells(Rows.Count, "AN").End(xlUp).Row
Se = Range("AN2:AN" & lr)
For s = 2 To UBound(Se)

For i = 1 To UBound(Ar)
For j = 1 To UBound(Ar, 2)
If Se(s, 1) <> "" And Se(s, 1) = Ar(i, j) Then
Debug.Print Se(s, 1)
.Item(Se(s, 1)) = i & "-" & Chr(64 + j + 4)
Else
y = .Item(Se(s, 1))
End If
Next j
Next i
Next s
i = 0
ReDim Res(.Count, 1)
For Each k In .keys
Res(i, 0) = k
Res(i, 1) = .Item(k)
i = i + 1
Next k
Range("AO2").Resize(.Count, 2) = Res
End With
End Sub


regards

estatefinds
08-02-2017, 02:38 PM
This one is taking a very long time, Ill add those codes to it to see if it speeds it up, thanks for helping, sincerely. loking to get it down to a maybe 2 minute speed. Thank you

SamT
08-02-2017, 03:56 PM
So.I have a question... the Values that need to be Found... Are they scattered all over the DataTable, or will they all be found in one column?

estatefinds
08-02-2017, 04:27 PM
Hi!

YES, scattered

SamT
08-02-2017, 05:48 PM
IIRC, you have several thousand rows and 34 columns in the datatable. That takes a while to search. You can garner a little more speed by sorting the entire sheet on column AO and only looping thru the empty cells. I won't make a lot of difference per cell, but if most of AO is not empty, it could add up to quite a bit.

estatefinds
08-02-2017, 06:03 PM
is there a way to hide the data that isnt highlighted temporarily to do the search or to ignore the data that isnt highlighted, to help it run faster?
The data that it searches for is highlighted in the E1 to AL9548, the highlighted ones are scattered within this range. there are over 5000 of them.
Let me know what you think?
Thank you

SamT
08-02-2017, 09:19 PM
s there a way to hide the data that isnt highlighted temporarily to do the search or to ignore the data that isnt highlighted, to help it run faster?
There are roughly 10K rows and about half contain needed data. IMO. it would not make a big enough difference to worry about.

OTOH, the loop must cycle thru all ~10K cells in AO. Shrinking that number directly reduces the loop count. Even if there is a 1:1 relation between empty AO cells and the ~5K highlighted cells, that cuts the loop count in half.

The fact of the matter is that it takes significant time to search, on average, 170K cells. (10K x 34 / 2)

Running some more numbers, 340K cells at, say, 100 bytes each is only 34MB of memory.

If speed is of the essence, I would place the entire datatable into an array and the empty cells in AO into a second array and the adjacent cells in AN into a third.

I would loop thru the AN array and look in the datatable array for matching values, then notate the AO array as indicated
I would also experiment with Join and "Concatenate" each "Row" in the data array into yet a fourth Single Dimensional array and test InStr to see if it was faster then looping thru the DataArray one element at a time.

Fennek
08-03-2017, 12:13 AM
Hallo,

the following code took 1.6 seconds for 10,000 rows and 20 columns searching for 4,000 items.

As I want to use the code later, cell-address is in the "E34"-style.



Sub Test2()
'matches values in An with the Range(E2:AL" & lastrow)
Anf = Timer
Dim L(51)

For i = 0 To 51
Letter = IIf(i < 26, Chr(65 + i), "A" & Chr(65 + i - 26))
L(i) = Letter
Next i
lr = Cells(Rows.Count, "AL").End(xlUp).Row
Ar = Range("E2:AL" & lr)
lr = Cells(Rows.Count, "AN").End(xlUp).Row
Res = Range("AN1:AO" & lr)

'load data into Dictionary
With CreateObject("scripting.dictionary")
For i = 1 To UBound(Ar)
For j = 1 To UBound(Ar, 2)
If Ar(i, j) <> "" Then
If Not .exists(Ar(i, j)) Then
.Item(Ar(i, j)) = L(j - 1 + 4) & i
Else
.Item(Ar(i, j)) = .Item(Ar(i, j)) & "|" & L(j - 1 + 4) & i
End If
End If
Next j
Next i
Debug.Print .Count, "time create Dic: " & Timer - Anf
'matching
For i = 2 To UBound(Res)
If Res(i, 2) = "" Then
Res(i, 2) = .Item(Res(i, 1))
End If
Next i
Range("AN1").Resize(UBound(Res), 2) = Res
End With
Debug.Print "total time", Timer - Anf
End Sub



regards

estatefinds
08-03-2017, 05:22 AM
Ill test when I return home later, and let you know how it worked. Thank you!

estatefinds
08-03-2017, 04:54 PM
it works very fast!!! Thank you
but i noticed the very top Value in column AO1 does not retrun the column row. its like it is offset one row down. so if you look at the combo in the
B group 1-3-8-20-22 it has 414-AB is what is should be. the same combo in group A 1-3-8-20-22 has AB413 the conern as it should be AB414. so if you compare the row values between group A and B. group B using my original code produces correct results the group A the row results are incorrect. is like its off setting.

Can this be corrected?

A




1-2-8-20-22



1-3-8-20-22
AB413


1-4-8-20-22
L462


2-3-8-20-22
AB472


1-5-8-20-22
I514







Should be this Below
B


1-2-8-20-22
#NA


1-3-8-20-22
414-AB


1-4-8-20-22
463-L


2-3-8-20-22
473-AB


1-5-8-20-22
515-I





C


1-2-8-20-22
369-Q


1-3-8-20-22
414-AB


1-4-8-20-22
463-L


2-3-8-20-22
473-AB


1-5-8-20-22
515-I





the group C is the original untouched sheet everything was accurate. can the code that you had done that works fast be corrected to get the correct results? For some reason the 369-Q or the Q369 isnt being resulted with the fast code.

i changed the ("E2:AL" & Ir). To ("E1:AL" & Ir) and the number is correct. For the 1-3-8-20-22. AB414

Fennek
08-03-2017, 11:16 PM
Hello,

I'm pleased, that the code is running.

The little changes (swap line-nr and column letter) or shift the index by one, you can do.

Thank you for the idea to substitute "Rang.Find" with this Dictionary approach.

regards

estatefinds
08-04-2017, 02:46 PM
Thank you for your help!! Much appreciated!!!:)