Search and Dump - Excel2000 Find Text and place text in new cell via Access2000 backend Table

Excel2000
Access2000
win 2000 sp3

What I have
Excel 2000:
One Workbook called  "MySearch"
One sheet called  "MyNewData"
FIRST ROW is a field header
Columns are:
    A                          B                  
Matches             Descriptions    <-   ROW 1 :  does not get overwritten



Access 2000:
One Database called "MyFind.mdb"
One Table "tblLook"
One Field  "fldValues"- Text 255   Alphanumeric  Characters
Example Values in table are:
1a222
12445
1DF59
1-5K89-55

Scenario:
Column B  "Descriptions"   will contain   Descriptions of products
No search values can be case sensitive.
Search Lookup in access table  may contain special characters.  like    -  ,   /  *   etc....


Main solution is:
I'am looking for values in these descriptions that may exist in the Access table/field "fldValues"
If it finds a match in the string  ANYWHERE it will take the value matched and place it in Column A under "MATCHES"
in the spreadsheet.

Then proceed to the Next cell down in Column B. If the next cell is empty. Stop Search.


Example:

Matches                 Descriptions
                            MOTOR,  NUMBER 1A222 PLASTIC FANS
                            BEARINGS PART#12445
                            MOTORCYCLE PART 1DF59 , PART OF ENGINE
                            CAR PARTS, TRUCK LATCH PART NUMBER 1-5K89-55, LISTED AS SEPERATE

END RESULT SHOULD LOOK LIKE.

Matches                 Descriptions
1A222                   MOTOR,  NUMBER 1A222 PLASTIC FANS
12445                   BEARINGS PART#12445
1DF59                   MOTORCYCLE PART 1DF59 , PART OF ENGINE
1-5K89-55             CAR PARTS, TRUCK LATCH PART NUMBER 1-5K89-55, LISTED AS SEPERATE
                                                        <----  empty cell   Stop Search
Thanks
fordraiders


LVL 3
FordraidersAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

R_RajeshCommented:
What i have done here is copy the entire tblLook table to sheet2 of the workbook then check each of thouse values against the values in mynewdata sheet, if a match is found then simply copy the value from sheet2 to columnA of mynewdata. to use this code open your MySearch workbook hit ALT+F11 select insert-module from the munu and paste the code. change the path of database accordingly. also make sure second sheet exists and is blank in your workbook

be sure to make a reference to latest version of Microsoft ActiveX Data Objects Library (in vbe you can do this by clicking tools-reference and selecting Microsoft ActiveX Data Objects Library)

-----------------------
Sub compare()
Dim conn As ADODB.Connection
Dim rst As ADODB.Recordset
Set conn = New ADODB.Connection
With conn
.Provider = "Microsoft.JET.OLEDB.4.0"
.Open "c:\temp\MyFind.mdb"
End With
Set rst = New ADODB.Recordset
With rst
.ActiveConnection = conn
.Open "SELECT * FROM tblLook"
End With
Sheets(2).Range("a1").CopyFromRecordset rst
Set rst = Nothing
conn.Close
  'finished transfer, now compare
For counter = 1 To Sheets(2).UsedRange.Rows.Count
toFind = Sheets(2).Cells(counter, 1).Text
found = Cells.Find(what:=toFind).Row
If found <> "" Then Cells(found, 1).Value = toFind
Next counter
End Sub

-----------------------
FordraidersAuthor Commented:
R_Rajesh,
It works for one row , but does not work on second description.

error on  
found = Cells.Find(what:=toFind).Row    <--------error "Object variable with block variable not set"

Thanks..
fordraiders
 
FordraidersAuthor Commented:
R_Rajesh,
After I declare my variables it seemed to work.
However, One thing that it is doing.
If a string is found and placed in the cell. If it so happens it finds another string in the same string.
The previous string gets overwritten?

Example:
Matches                 Descriptions
1A222                   MOTOR,  NUMBER 1A222 PLASTIC FANS 1DE45
12445                   BEARINGS PART#12445
1DF59                   MOTORCYCLE PART 1DF59 , PART OF ENGINE
1-5K89-55             CAR PARTS, TRUCK LATCH PART NUMBER 1-5K89-55, LISTED AS SEPERATE

Lets say the lookup values are:

1A222
12445
1DF59
1-5K89-55
1DE45    

Matches                 Descriptions
1DE45                   MOTOR,  NUMBER 1A222 PLASTIC FANS 1DE45   <------    
12445                   BEARINGS PART#12445
1DF59                   MOTORCYCLE PART 1DF59 , PART OF ENGINE
1-5K89-55             CAR PARTS, TRUCK LATCH PART NUMBER 1-5K89-55, LISTED AS SEPERATE




The 1DE45 will overwrite   1A222 in the first example:

If the Cell in Column A is already filled it gets bypassed.



Thanks
fordraiders

Price Your IT Services for Profit

Managed service contracts are great - when they're making you money. Yes, you’re getting paid monthly, but is it actually profitable? Learn to calculate your hourly overhead burden so you can master your IT services pricing strategy.

FordraidersAuthor Commented:
R_Rajesh,
I really don't think it is working.
The numbers on sheet2 are coming over in exact order as placed.
There is no searching going on.
R_RajeshCommented:
fordraiders,

works fine on my system, by the way i used the exact data you posted. if you feel the exact data is simply being copied just sort column b so that the data position gets changed then run the function

Please replace the last for loop with either of these

to add both the value (eg 1A222, 1DE45)
------------
For counter = 1 To Sheets(2).UsedRange.Rows.Count
toFind = Sheets(2).Cells(counter, 1).Text
found = Cells.Find(what:=toFind).Row
If found <> "" Then
Cells(found, 1).Value = IIf(Cells(found, 1).Value = _
"", toFind, Cells(found, 1).Value & ", " & toFind)
End If
Next counter
-------------------


to skip if already filled (eg 1A222)
-----------
For counter = 1 To Sheets(2).UsedRange.Rows.Count
toFind = Sheets(2).Cells(counter, 1).Text
found = Cells.Find(what:=toFind).Row
If found <> "" Then
Cells(found, 1).Value = IIf(Cells(found, 1).Value = _
"", toFind, Cells(found, 1).Value)
End If
Next counter
-----------------
R_RajeshCommented:
also could  you post the funciton as it is on your computer, with the declarations and modifications you have made.
FordraidersAuthor Commented:
R_Rajesh,

Sub compare()
Dim conn As ADODB.Connection
Dim rst As ADODB.Recordset
Set conn = New ADODB.Connection
With conn
.Provider = "Microsoft.JET.OLEDB.4.0"
.Open "c:\test\MyFind.mdb"
End With
Set rst = New ADODB.Recordset
With rst
.ActiveConnection = conn
.Open "SELECT * FROM tblLook"
End With
Sheets(2).Range("a1").CopyFromRecordset rst
Set rst = Nothing
conn.Close
Dim found As String
Dim toFind As String
For counter = 1 To Sheets(2).UsedRange.Rows.Count
toFind = Sheets(2).Cells(counter, 1).Text
found = Cells.Find(what:=toFind).Row
If found <> "" Then
Cells(found, 1).Value = IIf(Cells(found, 1).Value = _
"", toFind, Cells(found, 1).Value)
End If
Next counter
End Sub


Here is my Sub I have referenced  Activex Data Objects 2.7

Again,...
The code is stopping after posting only the first match.

Getting an error on this line

found = Cells.Find(what:=tofind).Row  <---- "Object variable with block variable not set.

I don't like sending files but, can you send me your sheet.
We are both posting the same thing and getting different results ?
Thanks
fordraiders



R_RajeshCommented:
Hi fordraiders,

try this while i have a look at the code

Please replace the last for loop with either of these

to add both the value (eg 1A222, 1DE45)
------------
Range("A2:A65536").ClearContents
For counter = 1 To Sheets(2).UsedRange.Rows.Count
toFind = Sheets(2).Cells(counter, 1).Text
With Worksheets("MyNewData").UsedRange
Set f = .Find(toFind, LookIn:=xlValues)
If Not f Is Nothing Then
MsgBox toFind & "- found in string " & f.Text
Range(f.Address).Offset(0, -1).Activate
ActiveCell.Value = IIf(ActiveCell.Value = "", _
toFind, ActiveCell.Value & ", " & toFind)
End If
End With
Next counter
-------------------

to skip if already filled (eg 1A222)
-----------
Range("A2:A65536").ClearContents
For counter = 1 To Sheets(2).UsedRange.Rows.Count
toFind = Sheets(2).Cells(counter, 1).Text
With Worksheets("MyNewData").UsedRange
Set f = .Find(toFind, LookIn:=xlValues)
If Not f Is Nothing Then
MsgBox toFind & "- found in string " & f.Text
Range(f.Address).Offset(0, -1).Activate
ActiveCell.Value = IIf(ActiveCell.Value = "", _
toFind, toFind)
End If
End With
Next counter
---------------
R_RajeshCommented:
ActiveCell.Value = IIf(ActiveCell.Value = "", _
toFind, toFind)

in the previous post the above line in second for loop should be

ActiveCell.Value = IIf(ActiveCell.Value = "", _
toFind, ActiveCell.Value)  <----
                                           
R_RajeshCommented:
still cant find anything wrong with the code...

it cant be anything to do with reference to ado library since the data is being copied to xl correctly. i think the problem is with the type of data its trying to compare try declaring the variables as variant instead of sting and try replacing all ".text" to ".value" in the code. as for sending you the sheet i cant find your email anywhere.

also try posing a larger sample of the actual data being compared, i sware i am not a spy working for your competitor :-)
FordraidersAuthor Commented:
staspe@insightbb.com

No big deal, I just know EE does not like it because it gives anyone else trying to post a disadvantage.
But,....
Everything is working now... no need to send...

Except,  The code below is not posting both finds..........


to add both the value (eg 1A222, 1DE45)
------------
For counter = 1 To Sheets(2).UsedRange.Rows.Count
toFind = Sheets(2).Cells(counter, 1).Text
found = Cells.Find(what:=toFind).Row
If found <> "" Then
Cells(found, 1).Value = IIf(Cells(found, 1).Value = _
"", toFind, Cells(found, 1).Value & ", " & toFind)
End If
Next counter
-------------------



Thanks a million!
fordraiders
FordraidersAuthor Commented:
R_RAJESH,
Sorry my fault again.... I had padded characters in Access database...
Working great....!
Although I don't need a solution.... The second time it finds a match... I don't get a new message box that it found the second match.

None the less ,  I thank you a million !
fordraiders
R_RajeshCommented:
hey fordraiders,

does data in sheet2 contain characters other than numbers and alphabets (eg @#$%) if so you will get the error message you mentioned.

as for your previous post, in sheet1 does the word we are trying to search get repeated in more than 1 cell i.e. can 1A222 appear in more than one cell because my code checks for only one instance of the search string. if it appears more than once i can change it to find all the occurance in the sheet
btw i was only joking about the email
FordraidersAuthor Commented:
Thanks,

does data in sheet2 contain characters other than numbers and alphabets (eg @#$%) if so you will get the error message you mentioned.    <---------------------

How can I avoid the error?
Thanks
R_RajeshCommented:
sorry my last comment was posted before i saw i yours but my comments on those special characters hold true. anyway the code below checks for all the occurance of the search sting and also changes the color of the cell containing more than one match.

---------------------
Sub compare()
Dim conn As ADODB.Connection
Dim rst As ADODB.Recordset
Set conn = New ADODB.Connection
With conn
.Provider = "Microsoft.JET.OLEDB.4.0"
.Open "c:\test\MyFind.mdb"
End With
Set rst = New ADODB.Recordset
With rst
.ActiveConnection = conn
.Open "SELECT * FROM tblLook"
End With
Sheets(2).Range("a1").CopyFromRecordset rst
Set rst = Nothing
conn.Close
'changes start from here
Range("A2:A65536").ClearContents
For counter = 1 To Sheets(2).UsedRange.Rows.Count
toFind = Sheets(2).Cells(counter, 1).Text
With Worksheets("MyNewData").Range("B2:B65536")
Set f = .Find(toFind, LookIn:=xlValues)
If Not f Is Nothing Then
firstAddress = f.Address
Do
Range(f.Address).Offset(0, -1).Activate
If ActiveCell.Value <> "" Then ActiveCell.Interior.Color = vbGreen
ActiveCell.Value = IIf(ActiveCell.Value = "", _
toFind, ActiveCell.Value & ", " & toFind)
Set f = .FindNext(f)
Loop While Not f Is Nothing And f.Address <> firstAddress
End If
End With
Next counter
End Sub
----------------------

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
R_RajeshCommented:
here we go again, i posted before your previous messaged was loaded anyway give me sometime, lets if we can do something about those characters...
FordraidersAuthor Commented:
I'am ready to give the points....

The enhancements can be for another day.
You have answered my original question....

Thanks
fordraiders
R_RajeshCommented:
Hey,

thanks, as for the enhancements you mention, just make a list of changes and post it. if i am successful, i will mail the sheet to you sometime in the morining (you will never guess what the time is here, its 4:15 AM). Ofcourse those special characters will be one of them.

by the way is it that only some characters appear in your data or could any special character appear, also in what position do they appear ? only at the end of the string or anywhere in between??
FordraidersAuthor Commented:
could be anywhere....

The characters that I need to Overlook is the  "-"  dash.  # pound sign  and the    "/"
Our lookup data is pretty clean.

Other than that ,  I need to get rid of the others.

Go to bed....
Thanks  fordraiders
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Office

From novice to tech pro — start learning today.