A For Each in Range... with a .Find(what:="TJ", ... in it problem

[Howard]

The sheet is concerned with Col A, B, C and returning values to col D.

I run this code as is and it finds the first occurrence of TJ in col C and returns 122; in col D. However, it does seem to run the full length of col D as the first occurrence of a "TJ" is row nine and the code runs for about1.5 seconds (or a bit less) given the 2400+ rows in col D.

I need it to find all occurrences of TJ and return the 122; (with semi-colon) in col D

Examples of what is in each column is adjacent to the Dim statements. Where KL & 98; are on same row, WK & 95; are on same row TJ & 394; are on same row and on down for about 25 rows, a string in A and number w/; next to it.

So with this entry in col C "MIRROR TYPE TJ KIT" I would expect col D to show 122;

And with this entry in col C "MIRROR KIT BLK 87-02 YJ/TJ" I would expect col D to show 394; 122;

With this in col C "ACC KIT HOOD SS 98-06" col D is blank because nothing in col A relates to anything in that particular string.

So, D can be blank, have one number/; or two number/; and maybe three number/;.

Code as is (in a bit of a test mode) has "TJ" and "122;" hard coded. So this is where I was going with "For Each aMod In Range("A1:A" & lngLstRow)".

Take each of the values in col A and look in col C for it and if there enter in col D the adjacent col B number/; of the col A value.

Thanks.
Howard

Option Explicit

Sub Auto_Mate()
Dim lngLstRow As Long
Dim aMod As Range ' Col A KJ, WK, TJ, YJ CJ
Dim ids As Range ' Col B 98; 95; 122; 394; 393;
Dim shDes As Range ' Col C MIRROR TYPE TJ KIT
' MIRROR KIT BLK 87-02 YJ/TJ
' ACC KIT HOOD SS 98-06
Dim aModCol As Range ' Col A
Dim idsCol As Range ' Col B
Dim shDesCol As Range ' Col C

lngLstRow = ActiveSheet.UsedRange.Rows.Count

With Sheet1
'For Each aMod In Range("A1:A" & lngLstRow)

Set shDesCol = .Columns(3).Find(what:="TJ", After:=.Cells(1, 3), _
LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
shDesCol.Offset(0, 1) = "122;"

If Not shDesCol Is Nothing Then Application.Goto shDesCol, True

'Next 'aMod
End With
End Sub

 

[Claus Busch]

Hi Howard,

Am Tue, 30 Jul 2013 23:07:40 -0700 (PDT) schrieb Howard:

I need it to find all occurrences of TJ and return the 122; (with semi-colon) in col D

in column D of the first occurence of TJ you will get all values with
semicolon:

Sub Auto_Mate()
Dim lngLstRow As Long
Dim shDes As Range
Dim shDesCol As Range
Dim firstAddress As String

lngLstRow = Sheets("Sheet1").UsedRange.Rows.Count
With Sheets("Sheet1").Range("C1:C" & lngLstRow)
Set shDesCol = .Find(what:="TJ", LookIn:=xlValues, Lookat:=xlPart)
If Not shDesCol Is Nothing Then
firstAddress = shDesCol.Address
Do
Range(firstAddress).Offset(, 1) = _
Range(firstAddress).Offset(, 1) & shDesCol.Offset(, -1) & "; "
Set shDesCol = .FindNext(shDesCol)
Loop While Not shDesCol Is Nothing And _
shDesCol.Address <> firstAddress
End If
End With
End Sub


Regards
Claus B.

 

[Claus Busch]

Hi Howard,

Am Wed, 31 Jul 2013 08:34:13 +0200 schrieb Claus Busch:

Set shDesCol = .Find(what:="TJ", LookIn:=xlValues, Lookat:=xlPart)

change the line above to:
Set shDesCol = .Find(what:="TJ", after:=Range("C" & lngLstRow), _
LookIn:=xlValues, Lookat:=xlPart)


Regards
Claus B.

 

[Howard]

Hi Howard,



Am Wed, 31 Jul 2013 08:34:13 +0200 schrieb Claus Busch:






change the line above to:

Set shDesCol = .Find(what:="TJ", after:=Range("C" & lngLstRow), _

LookIn:=xlValues, Lookat:=xlPart)





Regards

Claus B.

--

Win XP PRof SP2 / Vista Ultimate SP2

Office 2003 SP2 /2007 Ultimate SP2

Hi Claus,

I'm not explaining myself very well. Perhaps a look at this link will help..

I have hand entered a short sample of what should appear in col D. Where you see the word "blank", I don't want to return the text "blank", the word is there just to indicate that there would be no return for that col C string.

The strings in col A cannot be hard coded because the code will need to 'grab' each one in col A and see if it exists in the strings in col C. When amatch is found the return the value in col B next to whatever col A stringwas being looked up. Then take the next in col A and do the same.

If col D gets more than one return, don't overwrite the first, add to it.

Regards,
Howard

https://www.dropbox.com/s/0j6catqaavzz14z/Models IDs Drop Box.xlsm

 

[Claus Busch]

Hi Howard,

Am Wed, 31 Jul 2013 00:51:54 -0700 (PDT) schrieb Howard:

Perhaps a look at this link will help.

try:
Sub Auto_Mate_Claus()
Dim lngLstRow As Long
Dim rngC As Range
Dim shDes As Range
Dim firstAddress As String

With Sheets("Sheet1")
lngLstRow = .UsedRange.Rows.Count
For Each rngC In .Range("A2:A" & lngLstRow)
With .Range("C1:C" & lngLstRow)
Set shDes = .Find(what:=rngC, after:=Range("C1"), _
LookIn:=xlValues, Lookat:=xlPart)
If Not shDes Is Nothing Then
firstAddress = shDes.Address
Do
shDes.Offset(, 1) = shDes.Offset(, 1) & rngC.Offset(, 1)
Set shDes = .FindNext(shDes)
Loop While Not shDes Is Nothing And _
shDes.Address <> firstAddress
End If
End With
Next
End With
End Sub

Please paste the code in a STANDARD module


Regards
Claus B.

 

[Howard]

Hi Howard,



Am Wed, 31 Jul 2013 00:51:54 -0700 (PDT) schrieb Howard:






try:

Sub Auto_Mate_Claus()

Dim lngLstRow As Long

Dim rngC As Range

Dim shDes As Range

Dim firstAddress As String



With Sheets("Sheet1")

lngLstRow = .UsedRange.Rows.Count

For Each rngC In .Range("A2:A" & lngLstRow)

With .Range("C1:C" & lngLstRow)

Set shDes = .Find(what:=rngC, after:=Range("C1"), _

LookIn:=xlValues, Lookat:=xlPart)

If Not shDes Is Nothing Then

firstAddress = shDes.Address

Do

shDes.Offset(, 1) = shDes.Offset(, 1) & rngC.Offset(, 1)

Set shDes = .FindNext(shDes)

Loop While Not shDes Is Nothing And _

shDes.Address <> firstAddress

End If

End With

Next

End With

End Sub



Please paste the code in a STANDARD module





Regards

Claus B.

Hi Claus,

Fantastic! Very impressive.

Thank you, I appreciate your efforts.

Regards,
Howard

 

[GS]

Another way.., if you want to avoid the sheet read/write time for each
iteration!

Sub AutoMate2()
Dim vDataIn, vFind, vDataOut(), n&, k&
With ActiveSheet
vDataIn = .Range("A1:C" & .UsedRange.Rows.Count)
End With
With Application
vFind = .Transpose(.Index(vDataIn, 0, 3))
End With
ReDim vDataOut(1 To UBound(vDataIn), 1 To 1)
For n = LBound(vFind) To UBound(vFind)
For k = LBound(vDataIn) To UBound(vDataIn)
If InStr(1, vFind(n), vDataIn(k, 1)) > 0 Then
vDataOut(n, 1) = vDataOut(n, 1) & vDataIn(k, 2)
End If
Next 'k
Next 'n
ActiveSheet.Cells(1, 4).Resize(UBound(vDataOut)) = vDataOut
End Sub

Note that the results will be as per the order listed in colA. That
means your sample data will show this in colD...

122;
122;394;

...not...

122;
394;122;

...as you posted because the search string (YJ/TJ) in C2 doesn't match
the order of the find strings in ColA (TJ/YJ).<g> <FWIW>I don't know if
C2 is a typo but usually model options such as this would be shown in
ascending order (TJ/YJ), but this isn't necessarily a 'carved-in-stone'
rule but rather just what I've seen most common in my own experience.

--
Garry

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

 

[Howard]

Another way.., if you want to avoid the sheet read/write time for each

iteration!



Sub AutoMate2()

Dim vDataIn, vFind, vDataOut(), n&, k&

With ActiveSheet

vDataIn = .Range("A1:C" & .UsedRange.Rows.Count)

End With

With Application

vFind = .Transpose(.Index(vDataIn, 0, 3))

End With

ReDim vDataOut(1 To UBound(vDataIn), 1 To 1)

For n = LBound(vFind) To UBound(vFind)

For k = LBound(vDataIn) To UBound(vDataIn)

If InStr(1, vFind(n), vDataIn(k, 1)) > 0 Then

vDataOut(n, 1) = vDataOut(n, 1) & vDataIn(k, 2)

End If

Next 'k

Next 'n

ActiveSheet.Cells(1, 4).Resize(UBound(vDataOut)) = vDataOut

End Sub



Note that the results will be as per the order listed in colA. That

means your sample data will show this in colD...



122;

122;394;



..not...



122;

394;122;



..as you posted because the search string (YJ/TJ) in C2 doesn't match

the order of the find strings in ColA (TJ/YJ).<g> <FWIW>I don't know if

C2 is a typo but usually model options such as this would be shown in

ascending order (TJ/YJ), but this isn't necessarily a 'carved-in-stone'

rule but rather just what I've seen most common in my own experience.

Thanks, Garry.

Probably was a typo, your code posts as does Claus' does and that is just fine.

Thanks for taking the time to offer up another solution.

Regards,
Howard

 

[GS]

Thanks, Garry.

Probably was a typo, your code posts as does Claus' does and that is
just fine.

Yes, I see how Claus' works the same way. I have no problem with his
stuff as he's always got very good solutions for any given task, IMO.

Thanks for taking the time to offer up another solution.

You're welcome! As always, ..it's a pleasure for me to help! Just
thought you'd like to have an example of a more efficient option to
working directly on the sheet when the situation presents large amounts
of data. Since it's likely we won't know the amount it just makes sense
to me to provide the most efficient way regardless.

For example, I expect you'll notice the time a direct read/write (drw)
approach takes to process but will find the array approach returns
results almost instantaneously (by comparison) when processing high row
counts.

Actually, the times for each solution to process 1 block of your
following (ColC) sample data are:

MIRROR TYPE TJ KIT
MIRROR KIT BLK 87-02 YJ/TJ
ACC KIT HOOD SS 98-06
<blank>
<blank>

drw:
Time: 0.0156 secs;
Results:
122;
122;394;
<blank>
<blank>
<blank>

array: 0.0000 secs;
Results:
122;
122;394;
<blank>
<blank>
<blank>

The times for each solution to process 1000 rows (ie:200 instances) of
the same sample data in ColC are...

drw: 154.5156 secs
array: 0.8125 secs

...returning 200 instances of the same results.

Taking things a step further, I modified the 200 instances as
follows...

MIRROR TYPE TJ KIT
MIRROR KIT BLK 87-02 YJ/TJ
ACC KIT HOOD SS 98-06
MIRROR KIT BLK 87-02 YJ/TJ/KJ
MIRROR KIT BLK 87-02 YJ/TJ/KJ/WK/CJ

...so it includes a 3-value string as well as a string with all 5
values. The results were a surprise...

drw: 0.4688 secs
Results:
122;
122;394;

122;394;
95;122;394;393;

array: 1.0313 secs
Results:
122;
122;394;

98;122;394;
98;95;122;394;393;

Note that while the drw approach took less time it did not correctly
process the data containing the 3 and 5 value strings. I have not spent
any time to find out why so perhaps Claus will be interested to do
that!<g>

<FYI>Times were calc'd using VB's Timer object, and I've posted the
best times returned after running each procedure 3 times. Changes to
Claus' drw procedure were to add toggling ScreenUpdating/EnableEvents,
and switched the ref to Sheets("Sheet1") to 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

 

[Howard]

working directly on the sheet when the situation presents large amounts
of data. Since it's likely we won't know the amount it just makes sense
to me to provide the most efficient way regardless.

For example, I expect you'll notice the time a direct read/write (drw)
approach takes to process but will find the array approach returns
results almost instantaneously (by comparison) when processing high row
counts.

What I did after getting your code was to change the return col to E and left Claus's code to return to col D.

Then with the 2483 rows (and 25 "lookup items" in col A) I ran both codes. Without the benefit of a computer accurate timer, both "seemed" to take the same time, which I judged to be about 3 maybe 4 seconds at most.

First impressions are that's 'kinda slow' but given what it is doing I don't have much problem with that. I do remember you and Claus and one other contributor helping me with some data processing where I had 500,000 rows. The work being done on those rows was different than what I'm doing here, but the times of all three of the codes you guys offered up were in the neighborhood of .06 to .08 seconds. Seemed unbelievable to me.

Also, I entered =D2=E2 in col F and pulled down. Found 6 FALSE's whereyour code did not account for the word JEEP (5) and EXPLORER (1) and Claus' did accounted for them.

But I cannot find anywhere in your code where there may be a LEN(2) kind ofrestriction on the strings in col A to match. Am puzzled with that.

Howard

 

[GS]

Howard explained on 7/31/2013 :

What I did after getting your code was to change the return col to E and left
Claus's code to return to col D.

Then with the 2483 rows (and 25 "lookup items" in col A) I ran both codes.
Without the benefit of a computer accurate timer, both "seemed" to take the
same time, which I judged to be about 3 maybe 4 seconds at most.

First impressions are that's 'kinda slow' but given what it is doing I don't
have much problem with that. I do remember you and Claus and one other
contributor helping me with some data processing where I had 500,000 rows.
The work being done on those rows was different than what I'm doing here, but
the times of all three of the codes you guys offered up were in the
neighborhood of .06 to .08 seconds. Seemed unbelievable to me.

I remember the 500K rows project.

Also, I entered =D2=E2 in col F and pulled down. Found 6 FALSE's where your
code did not account for the word JEEP (5) and EXPLORER (1) and Claus' did
accounted for them.

But I cannot find anywhere in your code where there may be a LEN(2) kind of
restriction on the strings in col A to match. Am puzzled with that.

My code has no size restriction on the contents of colA. Not sure why
it would miss any entries unless their cols B/C were empty!

--
Garry

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

 

[Claus Busch]

Hi Garry,

Am Wed, 31 Jul 2013 19:56:08 -0400 schrieb GS:

Note that while the drw approach took less time it did not correctly
process the data containing the 3 and 5 value strings. I have not spent
any time to find out why so perhaps Claus will be interested to do
that!<g>

I tested it with your changes (3 and 5 value strings) but the result was
the same as yours.
Howard told in his question that he has 2400 rows and he is searching
for a maximum of two substrings. If my suggestion took more than 1
second of runtime I would have used arrays.


Regards
Claus B.

 

[GS]

Claus Busch wrote on 8/1/2013 :

Hi Garry,

Am Wed, 31 Jul 2013 19:56:08 -0400 schrieb GS:


I tested it with your changes (3 and 5 value strings) but the result was
the same as yours.
Howard told in his question that he has 2400 rows and he is searching
for a maximum of two substrings. If my suggestion took more than 1
second of runtime I would have used arrays.


Regards
Claus B.

Claus,
Thanks for the feedback and also taking the time to test. I may not
have been getting good results on the machine I was running on. Fact is
it turned itself off and now won't power up. It's fairly new and so is
still under warranty so we'll see what's up with it soon (I hope).
Meanwhile, the test file was open and so now lost. I'll have to rebuild
it and run more tests.

Later, Howard tried using it on longer search strings and reported
problems. I don't see what the length has to do with anything so I'm
wondering if it's an available resources issue because when I tried to
run 2400 rows it threw an exception and halted the process.

Howard does state that both approaches seem to run about the same for
him, and fairly quick. I think also that my contrived test data did not
match the actual case scenario. Maybe Howard can email me the
workbook...

--
Garry

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

 

[Howard]

Claus Busch wrote on 8/1/2013 :








Claus,

Thanks for the feedback and also taking the time to test. I may not

have been getting good results on the machine I was running on. Fact is

it turned itself off and now won't power up. It's fairly new and so is

still under warranty so we'll see what's up with it soon (I hope).

Meanwhile, the test file was open and so now lost. I'll have to rebuild

it and run more tests.



Later, Howard tried using it on longer search strings and reported

problems. I don't see what the length has to do with anything so I'm

wondering if it's an available resources issue because when I tried to

run 2400 rows it threw an exception and halted the process.



Howard does state that both approaches seem to run about the same for

him, and fairly quick. I think also that my contrived test data did not

match the actual case scenario. Maybe Howard can email me the

workbook...



--

Garry



Free usenet access at http://www.eternal-september.org

ClassicVB Users Regroup!

comp.lang.basic.visual.misc

microsoft.public.vb.general.discussion

Hi Gary,

I imported the timer code from that 500,000 row project to this one.

With the original data, (2,483 rows) Claus' code took 9.289 sec and yours took 5.989 sec.

With 2,483 rows of with this entry returning 6 IDs:

KJ THR WK ABC XK MIRROR JK KIT KK 5IN CJ ROUND BLK 41-64

Col D - Claus 14.523
Col E - Yours 6.055

=D2=E2 in the next column and pulled down - 100% = TRUE

I am happy with those results. Real data probably will NEVER simulate that many IDs returns.

Still a puzzle of your code NOT returning for the strings JEEP and EXPLORER with original data. Those are the only FALSE (6 total) I get using original data and both codes with =D2=E2.

In the 4th post of this thread is a drop box link to the original sheet.

Howard

 

[GS]

Ok, I've downloaded your file and will play with it.

Thanks for the feedback on run times. Clearly there is not enough data
being processed to make a significant impact on performance. My point
was to share the info so you know about the conceptual diff between drw
processing and array processing. As I've indicated earlier, I have no
problem with Claus' drw approach. (Claus is very knowledgeable and
clearly is an important asset to these NGs!)

--
Garry

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

 

[Howard]

Ok, I've downloaded your file and will play with it.



Thanks for the feedback on run times. Clearly there is not enough data

being processed to make a significant impact on performance. My point

was to share the info so you know about the conceptual diff between drw

processing and array processing. As I've indicated earlier, I have no

problem with Claus' drw approach. (Claus is very knowledgeable and

clearly is an important asset to these NGs!)

All good information!! Dang it, I wish I could just remember more of it.<g>

Howard