PDA

View Full Version : [SOLVED] search for the keywords and copy paste to another sheet



sindhuja
03-18-2015, 12:07 PM
Hi,

I have a excel with 2 sheets.

Sheet named "keyword" has list of words (minimum 10 words)

Sheet names "master" is the source in which i have to search for the keywords and copy paste the results in another new sheet.

words to be searched in the info 1,2,3,4 columns. Each word in keyword sheet should be searched in all the info columns.

Can anyone assist me with my requirement. i have attached the sample sheet for the reference.

Thanks,
Sinduja

sindhuja
03-18-2015, 07:17 PM
:help:help:help:help:help:help:help:help:help:help:help

Yongle
03-23-2015, 10:56 AM
There are several other ways to tackle this one, but this should give you what you want.
I have attached original worksheet with the macro included. I have added a sheet "result2", so that you can compare this against what you expected (per sheet "result"). Some of the items in your original "result" do not appear to match anything on the keyword list.
Assumption:
Assumes that you want an EXACT match for the keyword - so if keyword list includes "gift" only "gift" will be matched NOT "gifts"
Assumes there are no blank cells in columns A
How it works:
An array is set up to hold each keyword (arrayK)
Each value in columns E to H are compared in turn against each value in array
If there is a match, that row is copied to sheet "result2"
Finally, any duplicates that would occur if there are matches in more than one column within the same row are removed
The line of code wsR.Cells.ClearContents clears away all the previously copied values each time the macro is run. Pasting always begins at row2




Sub Search_Key_Words()

'declare and set variables
Dim LastRowK As Long, LastRowM As Long
Dim r As Integer, c As Integer, w As Integer, x As Integer, y As Integer, z As Integer
Dim arrayK() As Variant
Dim wsM As Worksheet, wsR As Worksheet, wsK As Worksheet
Set wsM = Sheets("master")
Set wsR = Sheets("result2")
Set wsK = Sheets("Keyword")
'clear old values in results sheet
wsR.Cells.ClearContents
'determine last row
LastRowK = wsK.Range("A1").End(xlDown).Row
LastRowM = wsM.Range("A1").End(xlDown).Row
'set dimensions of array
ReDim arrayK(LastRowK - 2)
'place keywords in array
For x = 0 To LastRowK - 2
arrayK(x) = wsK.Cells(x + 2, 1)
Next x
'create header row and set first row for data in results sheet
wsM.Range("A1:H1").Copy
wsR.Range("A1:H1").PasteSpecial xlPasteValues
z = 2
'run through columns E to H and check for values to match keywords
For w = 0 To LastRowK - 2
For r = 2 To LastRowM
For c = 5 To 8
If wsM.Cells(r, c) = arrayK(w) Then
For y = 1 To 8
wsR.Cells(z, y) = wsM.Cells(r, y)
Next y
z = z + 1 'adds 1 to row number in results sheet
Else
'do nothing
End If
Next c
Next r
Next w
'remove duplicate entries - could happen if keyword matches appear in more than one column
wsR.Range("A2:H" & z - 1).RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6, 7, 8), Header:=xlNo
End Sub

sindhuja
03-23-2015, 11:42 AM
Thank you so much for the assistance.

Can this be modified such as they key word searches are not for the EXACT words.

Even if it is "gift" or "gifts" it should be considered.

This is the sample sheet I have attached with few columns and rows. Will this work for the dynamic rows and column.

Also, the result2 should be amended for each search. If I run the macro again, the results should be after the last row of the result2 sheet.

sorry if am not clear in my earlier post.

-Sindhuja

Yongle
03-23-2015, 12:02 PM
Let's take everything one item at a time.
If you do not want it to be an exact match, you need to be very careful that you do not make the condition too loose. So you need to decide what is allowed and what is not allowed.
Shall we say that if the string begins with "tax" then it is a match? so taxes, taxation, taxidermy, taxonomy are a match?

Yongle
03-23-2015, 12:03 PM
This is the sample sheet I have attached with few columns and rows. Will this work for the dynamic rows and column.
Yes it will work for dynamic rows
No it will not work for dynamic columns - are you planning to add columns?

Yongle
03-23-2015, 12:06 PM
Also, the result2 should be amended for each search. If I run the macro again, the results should be after the last row of the result2 sheet.
It is easy to amend the macro to add the next results to the bottom of the range. Will all values in sheet "master" be new each time you run the macro?

Yongle
03-24-2015, 03:11 AM
Code amended to reflect your comments


(1) Can this be modified such as they key word searches are not for the EXACT words. Even if it is "gift" or "gifts" it should be considered.
Have replaced "EQUAL TO" with "LIKE" plus the wildcard "*" which means that any word beginning with the keyword will be matched.
If keyword is tax, matches could be tax, taxed, taxes, taxi etc
If keyword is taxes, only taxes would be matched from above list because it is the only one beginning with those 5 letters.
So the code becomes:

If wsM.Cells(r, c) Like arrayK(w) & "*" Then




(2) Also, the result2 should be amended for each search. If I run the macro again, the results should be after the last row of the result2 sheet.
Previous results are now retained and, by using a new variable LastRowR to set the starting point for variable z, results are now added after the last row of "result2"



(3) This is the sample sheet I have attached with few columns and rows. Will this work for the dynamic rows and column.
The rows are dynamic - so we do not need to amend anything
The columns are not dynamic.
The code is now amended to work for up to 12 columns (A to L). To amend it to reflect the number of columns in your worksheet, make changes as follows - replace 12 with the number of columns in your worksheet:

For y = 1 To 12
Amend in 3 lines the "L" to match your last column and amend the array to reflect the number of columns

wsR.Range("A2:L" & z - 1).RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12), Header:=xlNo


wsM.Range("A1:L1").Copy
wsR.Range("A1:L1").PasteSpecial xlPasteValues
The spreadsheet with my test data is attached.

Amended macro:

Sub Search_Key_Words()

'declare and set variables
Dim LastRowK As Long, LastRowM As Long, LastRowR As Long
Dim r As Integer, c As Integer, w As Integer, x As Integer, y As Integer, z As Integer
Dim arrayK() As Variant
Dim wsM As Worksheet, wsR As Worksheet, wsK As Worksheet
Set wsM = Sheets("master")
Set wsR = Sheets("result2")
Set wsK = Sheets("Keyword")
'determine last row
LastRowK = wsK.Range("A1").End(xlDown).Row
LastRowM = wsM.Range("A1").End(xlDown).Row
If wsR.Range("A2") = "" Then
LastRowR = 1
Else
LastRowR = wsR.Range("A1").End(xlDown).Row
End If
'set dimensions of array
ReDim arrayK(LastRowK - 2)
'place keywords in array
For x = 0 To LastRowK - 2
arrayK(x) = wsK.Cells(x + 2, 1)
Next x
'create header row and set first row for data in results sheet
wsM.Range("A1:L1").Copy
wsR.Range("A1:L1").PasteSpecial xlPasteValues
z = LastRowR + 1
'run through columns E to H and check for values to match keywords
For w = 0 To LastRowK - 2
For r = 2 To LastRowM
For c = 5 To 8

If wsM.Cells(r, c) Like arrayK(w) & "*" Then
For y = 1 To 12
wsR.Cells(z, y) = wsM.Cells(r, y)
Next y
z = z + 1 'adds 1 to row number in results sheet
Else
'do nothing
End If
Next c
Next r
Next w
'remove duplicate entries - could happen if keyword matches appear in more than one column
wsR.Range("A2:L" & z - 1).RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12), Header:=xlNo
End Sub

jonh
03-24-2015, 05:32 AM
Maybe you could use a query.

Copy the code to notepad, edit the file path and save with a dqy extension.

Run the file, copy the table where you want it and then you can just use 'refresh all' on the data menu.


XLODBC
1
DSN=Excel Files;DBQ=C:\Sampple.xlsx;
SELECT `master$`.* FROM `C:\Sampple.xlsx`.`master$`, `C:\Sampple.xlsx`.`keyword$` where (instr(1,`master$`.`info1 ` & ' ' & `master$`.info2 & ' ' & `master$`.info3 & ' ' & `master$`.info4,`keyword$`.Keywors))

sindhuja
03-24-2015, 10:03 AM
Hi All,:hi:

Thank you so much for all your help.

One last question - we have used arrary for the columns. If the columns are more than 50 do we need to use the numbers like 1,2,3,4..... 50..

or can this be done the other way.

-sindhuja

Yongle
03-25-2015, 12:06 AM
One last question - we have used arrary for the columns. If the columns are more than 50 do we need to use the numbers like 1,2,3,4..... 50..
or can this be done the other way.
Your earlier posts did not mention that there would be quite so many columns. I have amended the code to make the columns dynamic too.
You will see that I have added 2 variables LastCol and strLastCol
These hold the last column number and the last column alpha element respectively.
I have highlighted the changes in the code.
The addition of dynamic arrayR avoids the 1,2,3....50.. problem
The spreadsheet with my test data is attached
If the code is now achieving what you need, can you go to "thread tools" and mark this thread as "solved" - thanks



Sub Search_Key_Words()


'declare and set variables
Dim LastRowK As Long, LastRowM As Long, LastRowR As Long, LastCol As Long Dim r As Integer, c As Integer, w As Integer, x As Integer, y As Integer, z As Integer
Dim arrayK() As Variant, arrayR() As Variant
Dim wsM As Worksheet, wsR As Worksheet, wsK As Worksheet
Dim strLastCol As String
Set wsM = Sheets("master")
Set wsR = Sheets("result2")
Set wsK = Sheets("Keyword")
'determine last rows/column
LastRowK = wsK.Range("A1").End(xlDown).Row
LastRowM = wsM.Range("A1").End(xlDown).Row
If wsR.Range("A2") = "" Then
LastRowR = 1
Else
LastRowR = wsR.Range("A1").End(xlDown).Row
End If
LastCol = wsM.Range("A1").End(xlToRight).Column
'Last column letters ( ie column A or BQ etc)
strLastCol = Split(wsM.Range("A1").End(xlToRight).Address, "$")(1)
'set dimensions of arrays
ReDim arrayK(LastRowK - 2)
ReDim arrayR(LastCol - 1)
'place keywords in array
For x = 0 To LastRowK - 2
arrayK(x) = wsK.Cells(x + 2, 1)
Next x
'create header row and set first row for data in results sheet
wsM.Range("A1:" & strLastCol & "1").Copy
wsR.Range("A1:" & strLastCol & "1").PasteSpecial xlPasteValues
z = LastRowR + 1
'run through columns E to H and check for values to match keywords
For w = 0 To LastRowK - 2
For r = 2 To LastRowM
For c = 5 To 8
'If wsM.Cells(r, c) = arrayK(w) Then
If wsM.Cells(r, c) Like arrayK(w) & "*" Then
For y = 1 To LastCol
wsR.Cells(z, y) = wsM.Cells(r, y)
Next y
z = z + 1 'adds 1 to row number in results sheet
Else
'do nothing
End If
Next c
Next r
Next w
'remove duplicate entries - could happen if keyword matches appear in more than one column
For c = 0 To UBound(arrayR)
arrayR(c) = c + 1
Next c
wsR.Range("A2:" & strLastCol & z - 1).RemoveDuplicates Columns:=(arrayR), Header:=xlNo
End Sub