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.

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

On Tuesday, March 26, 2013 3:05:47 PM UTC-7, Claus Busch wrote:
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.



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

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:16384 13100251
WHI1,1,1638413100252,Match_Location_Number:1:16384 13100252
HPR1,1,2638413100253,Match_Location_Number:1:16384 13100253
VIK1,1,1638413100251,Match_Location_Number:1:16384 13100251
WHI1,1,1638413100252,Match_Location_Number:1:16384 13100252
HPR1,1,2638413100253,Match_Location_Number:1:16384 13100253

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

On Tuesday, March 26, 2013 4:07:38 PM UTC-7, Howard wrote:
On Tuesday, March 26, 2013 3:05:47 PM UTC-7, Claus Busch wrote:

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.







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



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:16384 13100251

WHI1,1,1638413100252,Match_Location_Number:1:16384 13100252

HPR1,1,2638413100253,Match_Location_Number:1:16384 13100253

VIK1,1,1638413100251,Match_Location_Number:1:16384 13100251

WHI1,1,1638413100252,Match_Location_Number:1:16384 13100252

HPR1,1,2638413100253,Match_Location_Number:1:16384 13100253



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

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

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:16384 13100251
WHI1,1,1638413100252,Match_Location_Number:1:16384 13100252
HPR1,1,2638413100253,Match_Location_Number:1:16384 13100253
VIK1,1,1638413100251,Match_Location_Number:1:16384 13100251
WHI1,1,1638413100252,Match_Location_Number:1:16384 13100252
HPR1,1,2638413100253,Match_Location_Number:1:16384 13100253

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
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2

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

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
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2

On Wednesday, March 27, 2013 2:03:33 AM UTC-7, Claus Busch wrote:
Hi Howard,

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

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,

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

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.

--
Adrien

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


Regards
Claus Busch


Hi,

I think you can write the Formula at once and be even faster:

Sub Tester4()
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

--
Adrien