Please review this macro? (it seems to work) and an additional question

[Windy Skies]

Based on: How to Automatically Autofilter Based Upon 'Contains Cell Value'

I have no clue what I am doing, so I am actually extremely surprised that it seems to work.

This is supposed to look for a value in cell E3, and filter the range $A$1:$A$46 to only display the rows that contain the value in that cell.

Sub Macro2()
'
' Macro2 Macro

Dim sCriteria As String

    Range("E3").Select
    Selection.Copy
sCriteria = "*" & Range("E3").Value & "*"
'

'

    ActiveSheet.Range("$A$1:$A$46").AutoFilter Field:=1, Criteria1:=sCriteria, _
        Operator:=xlAnd
End Sub

My previous post: http://www.mrexcel.com/forum/excel-...lter-based-contains-value-reference-cell.html

I have a LONG list of words I would like to associate with the phrases in the book they are used in. I could run this macro a thousand times and copy the result. It would be easier for me, for now and for future projects, if Excel could automatically generate a table like so:

Ideally, but I have no idea how to do this, Excel could do this automatically: based on a list of a 1000 words, generate a multiple-column table (word, associated phrase #1, associated phrase #2, ...., associated phrase #6 )

 

[Stridhan]

There's no problem in finding the words in the phrases but there's no delimiters so I can only return the whole phrase.
For example

知道 
will return
也不知道出于什么原因，如果一个“正常人”（正常人：非漫游者）发现一个漫游者随身带着毛巾，那么他会很自然地认为此人同样也有牙刷、浴衣、肥皂、装饼干的罐子、保温瓶、指南针、地图、绳捆、灭蚊喷剂、雨衣、太空服……等等。
　　因此，在搭便车漫游的行话中有这么一句，就是：“嘿，你碰过那个同行的福特·普里弗克特吗？那可是个真正知道自己的毛巾在哪里的好搭档。
”（碰：知道，认识，遇见，发生过性关系；同行：确实在一起的家伙；好搭档：在一起时让人惊叹的家伙）

福特看见这架势，知道自己必须跟在他后面。

 

[Windy Skies]

I would like it to return the whole phrase That result looks good.

How did you do this?

Next step is to get a word and its phrases on a single line, tab separated, like so: (word, associated phrase #1, associated phrase #2, ...., associated phrase #6 )

Simplest is probably inputting the 1000 words with Autohotkey into Excel and pasting the result into Notepad, and then in Word convert the line-breaks to tabs.

 

[Windy Skies]

Actually, when I was editing the phrases I was thinking a search result like this "10 characters*result*+10 characters" would be nice too.

A sample result would then be: "理学上的价值。也不知道出于什么原因，如果一"

 

[Windy Skies]

Too late to edit previous post:

Edit: but that is not possible in Excel I think, as you can't separate the text into cells if you want to do that. Then a macro in Word is the only option I think.

 

[Stridhan]

i wrote a simple macro that looks in column A in sheet2 for the words, header in A1,
then looks through sheet1 with the phrases, header in A1 and puttes each matching phrase in separate columns next the word.

Sub test()

Dim x As Long, y As Long, counter As Integer
Dim lr1 As Long, lr2 As Long
Dim ws1 As Worksheet, ws2 As Worksheet

Set ws1 = ThisWorkbook.Sheets("Sheet1")
Set ws2 = ThisWorkbook.Sheets("Sheet2")

lr1 = ws1.Cells(Rows.Count, 1).End(xlUp).Row
lr2 = ws2.Cells(Rows.Count, 1).End(xlUp).Row
counter = 1

If lr2 > 1 Then

Application.ScreenUpdating = False
    
For x = 2 To lr2
    For y = 2 To lr1
        If InStr(1, ws1.Cells(y, 1).Value, ws2.Cells(x, 1).Value) Then
            counter = counter + 1
                ws2.Cells(x, counter).Value = Trim(ws1.Cells(y, 1).Value)
        End If
    Next y
    counter = 1
Next x
Application.ScreenUpdating = True
End If

End Sub

 

[Windy Skies]

Wow! This is super cool! Thank you very much

 

[Stridhan]

You're welcome