Process dumped into an array...and then back to sheet

  • Thread starter Thread starter Howard
  • Start date Start date
H

Howard

As is, this code takes about 38 seconds to process just over 1 million rows.. Maybe that ain't too bad but I see GS, Claus, Isabelle et. al., speak of"...dumping into an array and when finished dumping back to the sheet..." or words to that affect to speed up processing a great deal.

I give myself credit to be smart enough to ask the question and bear full responsibility for being too dumb to be able to do it.

Here I'm taking a string (happens to be a set of digits) from MID and comparing with an equal length string of digits from RIGHT for a true or false return.

Option Explicit
Sub tester()
Dim c As Range
Application.ScreenUpdating = False
'c.Offset(0, 8) = "'" & Mid$(c, 8, 13)
'c.Offset(0, 9) = "'" & Right$(c, 13)
For Each c In Range("E1:E" & Range("E" & Rows.Count).End(xlUp).Row)
If Mid$(c, 8, 13) = Right$(c, 13) Then
c.Offset(0, 7).Value = "TRUE"
Else
c.Offset(0, 7).Value = "FALSE"
End If
Application.ScreenUpdating = True
Next
End Sub

Thanks.
Howard
 
Hi Howard,

Am Tue, 26 Mar 2013 14:30:42 -0700 (PDT) schrieb Howard:
As is, this code takes about 38 seconds to process just over 1 million rows. Maybe that ain't too bad but I see GS, Claus, Isabelle et. al., speak of "...dumping into an array and when finished dumping back to the sheet..." or words to that affect to speed up processing a great deal.

I give myself credit to be smart enough to ask the question and bear full responsibility for being too dumb to be able to do it.

Here I'm taking a string (happens to be a set of digits) from MID and comparing with an equal length string of digits from RIGHT for a true or false return.
Click to expand...

If Mid$(c, 8, 13) = Right$(c, 13)
is always true if len(c) = 20. Therefore try a quicker version:

Sub tester2()
Dim st As Double
Dim LRow As Long

st = Timer
LRow = Cells(Rows.Count, "E").End(xlUp).Row
Application.ScreenUpdating = False
[L1].Formula = "=Len(E1)=20"
Range("L1").AutoFill Range("L1:L" & LRow)
Application.ScreenUpdating = True
MsgBox Format(Timer - st, "0.000") & " sec"
End Sub


Regards
Claus Busch
 
Hi Howard,



Am Tue, 26 Mar 2013 14:30:42 -0700 (PDT) schrieb Howard:


As is, this code takes about 38 seconds to process just over 1 million rows. Maybe that ain't too bad but I see GS, Claus, Isabelle et. al., speak of "...dumping into an array and when finished dumping back to the sheet...." or words to that affect to speed up processing a great deal.

I give myself credit to be smart enough to ask the question and bear full responsibility for being too dumb to be able to do it.

Here I'm taking a string (happens to be a set of digits) from MID and comparing with an equal length string of digits from RIGHT for a true or false return.
Click to expand...



If Mid$(c, 8, 13) = Right$(c, 13)

is always true if len(c) = 20. Therefore try a quicker version:



Sub tester2()

Dim st As Double

Dim LRow As Long



st = Timer

LRow = Cells(Rows.Count, "E").End(xlUp).Row

Application.ScreenUpdating = False

[L1].Formula = "=Len(E1)=20"

Range("L1").AutoFill Range("L1:L" & LRow)

Application.ScreenUpdating = True

MsgBox Format(Timer - st, "0.000") & " sec"

End Sub





Regards

Claus Busch

--

Win XP PRof SP2 / Vista Ultimate SP2

Office 2003 SP2 /2007 Ultimate SP2
Click to expand...

Thanks Claus, that is one lightning fast process. In my testing your code it returns FALSE for every entry. Am I to incorporate that process into mycode that does the comparison and use yours to post the TRUE/FALSE results?

If so, I'm at a loss to do so.

<If Mid$(c, 8, 13) = Right$(c, 13)is always true if len(c) = 20.>
I see what you are saying here, it would compare n to itself to and of course that would be true. I'm thinking that len(c) = 20 will never happen.

Here is a tiny sample with the third and sixth line having errors as the two 13 digit numbers don't match.

The 13 starting just past the second comma and the 13 past the second :

VIK1,1,1638413100251,Match_Location_Number:1:1638413100251
WHI1,1,1638413100252,Match_Location_Number:1:1638413100252
HPR1,1,2638413100253,Match_Location_Number:1:1638413100253
VIK1,1,1638413100251,Match_Location_Number:1:1638413100251
WHI1,1,1638413100252,Match_Location_Number:1:1638413100252
HPR1,1,2638413100253,Match_Location_Number:1:1638413100253

Also, I was grossly wrong saying my posted code (which works fine except for the speed) took 38 seconds to process 1 milloion rows...
DUH, I only had 100,000 + rows and it took 38 sec. A million rows with my code is "...come back tomorrow to see the results."

Howard
 
Hi Howard,
Am Tue, 26 Mar 2013 14:30:42 -0700 (PDT) schrieb Howard:
As is, this code takes about 38 seconds to process just over 1 million rows. Maybe that ain't too bad but I see GS, Claus, Isabelle et. al., speak of "...dumping into an array and when finished dumping back to the sheet..." or words to that affect to speed up processing a great deal.
Click to expand...
I give myself credit to be smart enough to ask the question and bear full responsibility for being too dumb to be able to do it.
Click to expand...
Here I'm taking a string (happens to be a set of digits) from MID andcomparing with an equal length string of digits from RIGHT for a true or false return.
Click to expand...
If Mid$(c, 8, 13) = Right$(c, 13)
is always true if len(c) = 20. Therefore try a quicker version:
Sub tester2()
Dim st As Double
Dim LRow As Long
st = Timer
LRow = Cells(Rows.Count, "E").End(xlUp).Row
Application.ScreenUpdating = False
[L1].Formula = "=Len(E1)=20"
Range("L1").AutoFill Range("L1:L" & LRow)
Application.ScreenUpdating = True
MsgBox Format(Timer - st, "0.000") & " sec"
End Sub
Regards
Click to expand...

Claus Busch
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2
Click to expand...



Thanks Claus, that is one lightning fast process. In my testing your code it returns FALSE for every entry. Am I to incorporate that process into my code that does the comparison and use yours to post the TRUE/FALSE results?



If so, I'm at a loss to do so.



<If Mid$(c, 8, 13) = Right$(c, 13)is always true if len(c) = 20.>

I see what you are saying here, it would compare n to itself to and of course that would be true. I'm thinking that len(c) = 20 will never happen..



Here is a tiny sample with the third and sixth line having errors as the two 13 digit numbers don't match.



The 13 starting just past the second comma and the 13 past the second :



VIK1,1,1638413100251,Match_Location_Number:1:1638413100251

WHI1,1,1638413100252,Match_Location_Number:1:1638413100252

HPR1,1,2638413100253,Match_Location_Number:1:1638413100253

VIK1,1,1638413100251,Match_Location_Number:1:1638413100251

WHI1,1,1638413100252,Match_Location_Number:1:1638413100252

HPR1,1,2638413100253,Match_Location_Number:1:1638413100253



Also, I was grossly wrong saying my posted code (which works fine except for the speed) took 38 seconds to process 1 milloion rows...

DUH, I only had 100,000 + rows and it took 38 sec. A million rows with my code is "...come back tomorrow to see the results."



Howard
Click to expand...

Hi Claus,

Here is what I have tried.

Errors out with Object Required.

Sub MyTesterClausSpeedo()
Dim st as Object 'Variant
Dim LRow As Range
Dim c As Range
Set LRow = Cells(Rows.Count, "E").End(xlUp).Row
Application.ScreenUpdating = False
'c.Offset(0, 8) = "'" & Mid$(c, 8, 13)
'c.Offset(0, 9) = "'" & Right$(c, 13)
For Each c In Range("E1:E" & Range("E" & Rows.Count).End(xlUp).Row)
st = Timer
If Mid$(c, 8, 13) = Right$(c, 13) Then
LRow = Cells(Rows.Count, "E").End(xlUp).Row
[L1].Formula = "=Len(E1)=20"
Range("L1").AutoFill Range("L1:L" & LRow)
End If
MsgBox Format(Timer - st, "0.000") & " sec"
Next
Application.ScreenUpdating = True

End Sub

Howard
 
Howard,
Is it possible for you to please not include in your posts prior
content to the reply you're responding to. This makes it hard for us to
get at your recent comments when we have to scroll all the way down
past stuff we've already read/replied to! (Just delete everything above
the comments you're addressing)

Now.., in response to your request for how to dump data into an array
and process it there, then dump it back into the worksheet...

Sub Tester2()
Dim vDataIn, v1, v2, vDataOut(), n&
vDataIn = Range("E1:E" & Range("E" & Rows.Count).End(xlUp).Row)
ReDim vDataOut(1 To UBound(vDataIn))
For n = LBound(vDataIn) To UBound(vDataIn)
v1 = Split(vDataIn(n, 1), ","): v2 = Split(v1(3), ":")
vDataOut(n) = (v1(2) = v2(2))
Next 'n
Range("E1").Offset(0, 7).Resize(UBound(vDataOut)) =
WorksheetFunction.Transpose(vDataOut)
End Sub

...which will load your data into an array to analyze, put the results
into another array as it does, and dump that array into the column
specified in Offset().

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion
 
Hi Garry,

Sure I'll see if I can comply to deletion advice. Did not know it was a problem but of course I don't chase anywhere near the number of post you pros do.

So I hoping this reply is an example of how I should go about the deletion process.

Thanks for the advice and the code you offer.

I'll give it a go. It does seem strange to me in that I can't figure where it does any comparisons of the strings. Maybe it will dawn on me when I get it in my sheet and study it more.

Howard
 
Garry,
I tried you code and it errored out with a type mismatch.
Would that be something on my sheet or a small adjustment to the code?
Howard
 
Hi Garry,
Sure I'll see if I can comply to deletion advice. Did not know it
was a problem but of course I don't chase anywhere near the number of
post you pros do.

So I hoping this reply is an example of how I should go about the
deletion process.

Thanks for the advice and the code you offer.

I'll give it a go. It does seem strange to me in that I can't figure
where it does any comparisons of the strings. Maybe it will dawn on
me when I get it in my sheet and study it more.

Howard
Click to expand...

This line...

vDataOut(n) = (v1(2) = v2(2))

...loads the return of True if it matches, False if not. What might help
is to look at how it parses each line of the data. First thing is to
split the line into segments separated by commas. The last segment,
v1(3), is delimited by ":" and so splitting it into segments enables
comparing the position of the digits in v1,element2 and v2,element2 to
see if they match. The line above automatically returns True or False
base on match and so loads that into vDataOut in the same place as the
source data was in vDataIn so we keep row alignment.

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion
 
Garry,
I tried you code and it errored out with a type mismatch.
Would that be something on my sheet or a small adjustment to the
code? Howard
Click to expand...

All array variables are Variants! It worked fine for the sample data
you posted! (List in colE, results post to colL)

Is the source range correctly defined? Are you running it on the sheet
that contains the data to be processed? (It assumes ActiveSheet)

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion
 
Garry,
I tried you code and it errored out with a type mismatch.
Would that be something on my sheet or a small adjustment to the
code? Howard
Click to expand...

Also, each line of code is a single line, so the last line where it
dumps vDataOut into colL may have wrapped in your reader.

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion
 
Well, I don't know what I changed except instead of testing it on 200,000 + rows, I dumped all but about 15, and it works just like you knew it would. Drug the data on down to around 1800 rows and it works just fine.

So, I'm thinking I had something amok but now it its a blink and done!

Sure do like you guy's and gal's work. And I appreciate it.

Thanks.

Are these last couple of posts more in line with the deletion of prior post stuff you adviced me on?

Regards,
Howard
 
Well, I don't know what I changed except instead of testing it on
200,000 + rows, I dumped all but about 15, and it works just like you
knew it would. Drug the data on down to around 1800 rows and it
works just fine.

So, I'm thinking I had something amok but now it its a blink and
done!
Excellent!

Sure do like you guy's and gal's work. And I appreciate it.

Thanks.
Click to expand...

You're welcome! Always glad to help...
Are these last couple of posts more in line with the deletion of
prior post stuff you adviced me on?
Click to expand...

Well you deleted the part you were replying to, but it's much easier.
Good job!

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion
 
Garry,
I tried you code and it errored out with a type mismatch.
Would that be something on my sheet or a small adjustment to the
code? Howard
Click to expand...
Also, each line of code is a single line, so the last line where it
dumps vDataOut into colL may have wrapped in your reader.
Click to expand...

Garry, yes the last line did wrap but showed up in red in the editor. Fixed it right off the bat.

As for the Type Mismatch it errors out at 65536 + 1 row. One row past Excel2007max rows. I'm using Excel 2010. The sheet started out as a saved macro enabled 2010 whatever you want to call it... sheet and has been saved again since for whatever that's worth.

Just for you info, that's what I found. Not worth much more effort to me as I can live with that. If there is something I should do on my end, I'll give it a try. Otherwise so be it.

Thanks again.

Regards,
Howard
 
Garry,
Garry, yes the last line did wrap but showed up in red in the editor.
Fixed it right off the bat.

As for the Type Mismatch it errors out at 65536 + 1 row. One row past
Excel 2007max rows. I'm using Excel 2010. The sheet started out as
a saved macro enabled 2010 whatever you want to call it... sheet and
has been saved again since for whatever that's worth.

Just for you info, that's what I found. Not worth much more effort
to me as I can live with that. If there is something I should do on
my end, I'll give it a try. Otherwise so be it.

Thanks again.

Regards,
Howard
Click to expand...

Actually, XL2007 max rows is about 1 million AFAIK, but is memory
dependant. I did the test in XL2003 but that only permitted 65536 rows
of data. I suspect the issue is whether the array grabbed the entire
list due to available resources.

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion
 
Actually, XL2007 max rows is about 1 million AFAIK, but is memory
dependant. I did the test in XL2003 but that only permitted 65536 rows

of data. I suspect the issue is whether the array grabbed the entire

list due to available resources.
Click to expand...


I'm a happy camper with this.

Thanks Garry
 
Hi Howard,

Am Tue, 26 Mar 2013 16:07:38 -0700 (PDT) schrieb Howard:
The 13 starting just past the second comma and the 13 past the second :

VIK1,1,1638413100251,Match_Location_Number:1:1638413100251
WHI1,1,1638413100252,Match_Location_Number:1:1638413100252
HPR1,1,2638413100253,Match_Location_Number:1:1638413100253
VIK1,1,1638413100251,Match_Location_Number:1:1638413100251
WHI1,1,1638413100252,Match_Location_Number:1:1638413100252
HPR1,1,2638413100253,Match_Location_Number:1:1638413100253
Click to expand...

sorry, but I didn't know your data.
Try:

Sub Tester3()
Dim LRow As Long
Dim st As Double

st = Timer
LRow = Cells(Rows.Count, "E").End(xlUp).Row
Range("L1").Formula = "=len(Substitute(E1,mid(E1,8,13),))=len(E1)-26"
Range("L1").AutoFill Range("L1:L" & LRow)
MsgBox Format(Timer - st, "0.000")
End Sub


Regards
Claus Busch
 
Hi Howard,

Am Wed, 27 Mar 2013 09:30:53 +0100 schrieb Claus Busch:
Sub Tester3()
Dim LRow As Long
Dim st As Double

st = Timer
LRow = Cells(Rows.Count, "E").End(xlUp).Row
Range("L1").Formula = "=len(Substitute(E1,mid(E1,8,13),))=len(E1)-26"
Range("L1").AutoFill Range("L1:L" & LRow)
MsgBox Format(Timer - st, "0.000")
End Sub
Click to expand...

still a little bit quicker:

Sub Tester3()
Dim LRow As Long
Dim st As Double

st = Timer
LRow = Cells(Rows.Count, "E").End(xlUp).Row
Range("L1").Formula = "=find(right(E1,13),E1)=8"
Range("L1").AutoFill Range("L1:L" & LRow)
MsgBox Format(Timer - st, "0.000")
End Sub


Regards
Claus Busch
 
Hi Howard,
Click to expand...
still a little bit quicker:



Sub Tester3()

Dim LRow As Long

Dim st As Double



st = Timer

LRow = Cells(Rows.Count, "E").End(xlUp).Row

Range("L1").Formula = "=find(right(E1,13),E1)=8"

Range("L1").AutoFill Range("L1:L" & LRow)

MsgBox Format(Timer - st, "0.000")

End Sub
Click to expand...
Regards

Claus Busch
Click to expand...

Nothing short of amazing! 500,000 rows in 1.045 seconds.
A snippet of code small enough to write onto the palm of your hand will do that much work and at that speed.

Claus, thank you so much.

Regards,
Howard
 
Hi Howard,

Am Wed, 27 Mar 2013 03:05:22 -0700 (PDT) schrieb Howard:
Nothing short of amazing! 500,000 rows in 1.045 seconds.
A snippet of code small enough to write onto the palm of your hand will do that much work and at that speed.
Click to expand...

almost always there are more than one solutions for one problem. And so
you can choose whether you take the best solution in handling, the
nicest or the quickest.


Regards
Claus Busch
 
Hi,

Le 27/03/2013 10:03, Claus Busch a écrit :
still a little bit quicker:

Sub Tester3()
Dim LRow As Long
Dim st As Double

st = Timer
LRow = Cells(Rows.Count, "E").End(xlUp).Row
Range("L1").Formula = "=find(right(E1,13),E1)=8"
Range("L1").AutoFill Range("L1:L" & LRow)
MsgBox Format(Timer - st, "0.000")
End Sub
Click to expand...

Wouldn't writing the formulae at once be even faster?

Sub Tester3()
Dim LRow As Long
Dim st As Double

st = Timer
LRow = Cells(Rows.Count, "E").End(xlUp).Row
Range("L1:L" & LRow).Formula = "=find(right(E1,13),E1)=8"
MsgBox Format(Timer - st, "0.000")
End Sub

Also, your new formula doesn't always give the same results as "=Mid(E1,
8, 13) = Right(E1, 13)", e.g. on strings like
ABCDEFGABCDEFGABCDEFGABCDEF or AAAAAAAAAAAAAAAAAAAA, but maybe it's ok
for the intended purpose.
 
Back
Top