search for keywords within many words in a cell

[dan2010]

Hi,

i am trying to figure out the coding to search for different keywords, then copy and paste them into another sheet in different columns.

eg.

cell 1A :
john
banana
$1.2

cell 2A :
kelvin
durian
$2.4

cell 3A :
kenny
orange
$1.5

cell 1B:
kenny
durian
$1.3

cell 2B:
john
banana
$1.2

the list goes on....from 1A to 30D

all these data are in sheet1. My plan is to sort these data into sheet2.
those data with john goes to 1st column, those with kelvin goes to column 2, those with kenny goes to 3rd column...and so on

i have tried using wildcard, but nothing happens.

for i = 1 to 30
for j = 1 to 4

select case cells(i,j)
case "*john*"
sheet1.cells(i,j).copy
sheet2.cells(a,1).pastespecial xlpastevalues
a=a+1

case "*kelvin*"
sheet1.cells(i,j).copy
sheet2.cells(b,2).pastespecial xlpastevalues
b=b+1

case "*kenny*"
sheet1.cells(i,j).copy
sheet2.cells(c,3).pastespecial xlpastevalues
c=c+1

end select
next
next

does anyone has any idea how to solve my problem? thanks =D

[StephenR]

Untested, but does this work?

case Like "*john*"

[Marcol]

Try this assuming you have set your range and variables a, b, c

    For i = 1 To 30
        For j = 1 To 4

            Select Case True
                Case InStr(1, LCase(Cells(i, j)), "john") > 0
                    Sheet1.Cells(i, j).Copy
                    Sheet2.Cells(a, 1).PasteSpecial xlPasteValues
                    a = a + 1

                Case InStr(1, LCase(Cells(i, j)), "kelvin") > 0
                    Sheet1.Cells(i, j).Copy
                    Sheet2.Cells(b, 2).PasteSpecial xlPasteValues
                    b = b + 1

                Case InStr(1, LCase(Cells(i, j)), "kenny") > 0
                    Sheet1.Cells(i, j).Copy
                    Sheet2.Cells(c, 3).PasteSpecial xlPasteValues
                    c = c + 1

            End Select
        Next
    Next

Hope this helps

[snb]

Use Excel's Builtin facilities.

Sub tst66()
  Cells(1, 4) = Cells(1, 1)
  For j = 1 To 3
    Cells(2, 4) = Choose(j, "*John*", "*Kelvin*", "*Kenny*")
    Columns(1).AdvancedFilter xlFilterCopy, Range("D1:D2"), Cells(1, 10 + (2 * j))
  Next    
End Sub

[dan2010]

StephenR : the code is not valid

Marcol : i tried your coding but nothing happens.

snb : it returns runtime error 1004. " The command could not be completed by using the range specified.Select a single cell within the range and try the command again."

[dan2010]

Sub extractdata3()
l = 1
For a = 1 To 30
  For j = 1 To 4

    If Sheet1.Cells(a, j) = "*john*" Then
    k = 1
    End If

    If Sheet1.Cells(a, j) = "*kelvin*" Then
    k = 3
    End If
    
    If Sheet1.Cells(a, j) = "*kenny*" Then
    k = 3
    End If
    MsgBox k

    If Not k = 0 Then
    Sheet2.Cells(l, k) = Choose(k, "*John*", "*Kelvin*", "*Kenny*")
    l = l + 1
    Else
    End If
    nextline:
  Next
Next
End Sub

i have tried this code but it does not work too. it always return k = 0. I have tried to use "john","kelvin","kenny" and it works. So is there any replacement coding for "*john*","*kelvin*","*kenny*" ?

[Marcol]

My mistake try this

Option Explicit

Sub test()
    Dim i As Integer, j As Integer
    Dim a As Integer, b As Integer, c As Integer
    
    For i = 1 To 30
        For j = 1 To 4

            Select Case True
                Case InStr(1, LCase(Cells(i, j)), "john") > 0
                    a = a + 1
                    Sheet1.Cells(i, j).Copy
                    Sheet2.Cells(a, 1).PasteSpecial xlPasteValues

                Case InStr(1, LCase(Cells(i, j)), "kelvin") > 0
                    b = b + 1
                    Sheet1.Cells(i, j).Copy
                    Sheet2.Cells(b, 2).PasteSpecial xlPasteValues

                Case InStr(1, LCase(Cells(i, j)), "kenny") > 0
                    c = c + 1
                    Sheet1.Cells(i, j).Copy
                    Sheet2.Cells(c, 3).PasteSpecial xlPasteValues

            End Select
        Next
    Next

End Sub

If this still does nothing, or doesn't give you the result you need, post a sample workbook.

[snb]

Sub tst66()
  With sheets(1)
    .Cells(1, 4) = .Cells(1, 1)
    For j = 1 To 3
    .Cells(2, 4) = Choose(j, "*John*", "*Kelvin*", "*Kenny*")
    .usedrange.Columns(1).AdvancedFilter xlFilterCopy, .Range("D1:D2"), .Cells(1, 10 + (2 * j))
    Next    
  End With
End Sub

It's imperative that A1 serves as a 'Fieldname'.
Cfr. the attachment

[dan2010]

do u mind explaining

  With sheets(1)
    .Cells(1, 4) = .Cells(1, 1)

why is cell D1 = A1? when the data are copied to column H,J,L

and

.Cells(2, 4) = Choose(j, "*John*", "*Kelvin*", "*Kenny*")

there is nothing in cell D2.

and

    .usedrange.Columns(1).AdvancedFilter xlFilterCopy, .Range("D1:D2"), .Cells(1, 10 + (2 * j))

i do not understand the entire line of the code :S

[snb]

the selectioncriteria for advanced filter will be put into D1:D2

.usedrange.Columns(1).AdvancedFilter xlFilterCopy, .Range("D1:D2"), .Cells(1, 10 + (2 * j))

the selectioncriteria indicate which field has to be filtered
so D1 has to contain the same fieldname as the column to be filtered.
that column's fieldname is in A1
ergo put the fieldname of column 1 (A1) in the fieldselectorcriterion D1
.Cells(1, 4) = .Cells(1, 1)

put in D2 the value that has to be filtered in column 1
.Cells(2, 4) = Choose(j, "*John*", "*Kelvin*", "*Kenny*")

If you want to know what advancedfilter is :
I can't explain better than F1, a good Excel-VBA-book, an Internet Excelcourse or a classroom Excel-VBA course can.

[Leith Ross]

Hello dan2010,

When asking for explanations of code, you should also state if the code worked or not. If not, you should include the line where the failure occurred, and the number of the error. If it does work and you have no further changes that need to be made then please marked your post solved and thank those who helped you.

[StephenR]

Dan - I suggest you post a sample workbook and I'm sure we can sort it out in no time.

[snb]

If the range you want to inspect is B1:E32.

Sub tst66()
  With sheets(1)
    For j=2 to 5
       .Cells(1, 7) = .Cells(1, j)
       For jj = 1 To 3
       .Cells(2, 7) = Choose(jj, "*John*", "*Kelvin*", "*Kenny*")
       .range("B1:B32").offset(,j-2).AdvancedFilter xlFilterCopy, .Range("G1:G2"), .cells(rows.count,10 + (2 * jj)).end(xlup).offset(1)
       Next 
    Next
  End With
End Sub

[dan2010]

snb : i see. thank you. i will keep ur code for reference.

StephenR : it is okay. i have found another "easier to understand" solution for my problem, using "if range.value like "*variable*" then..."

i would like to thank StephenR, Marcol and especially snb for all the time and effort spent giving me all the help and suggestions. thank you very much =D