=IF(ISNUMBER(SEARCH("abc",A1,1)),"Y","N")

[Eraengineer]

I am looking for this but in VBA....third post on trying to get an answer to this. The trick is I not only want this in VBA but I want it to run down the entire column in a loop until it hits a black cell in the column. Any suggestions!?

 

[Domenic]

The following macro will insert the formula in Column B...

[font=Verdana][color=darkblue]Sub[/color] test()

    [color=darkblue]Dim[/color] LastRow [color=darkblue]As[/color] [color=darkblue]Long[/color]
    
    LastRow = Cells(Rows.Count, "A").End(xlUp).Row
    
    Range("B1:B" & LastRow).Formula = "=IF(ISNUMBER(SEARCH(""abc"",A1,1)),""Y"",""N"")"
    
    
[color=darkblue]End[/color] [color=darkblue]Sub[/color][/font]

 

[Eraengineer]

Thanks! Now instead of placing a Y if the cell contains abc can you make it copy and paste that information in the same column but on a different sheet?

 

[Eraengineer]

by that information I mean the abc

 

[Domenic]

Try...

[font=Verdana][color=darkblue]Option[/color] [color=darkblue]Explicit[/color]

[color=darkblue]Sub[/color] test1()

    [color=darkblue]Dim[/color] wksSource [color=darkblue]As[/color] Worksheet
    [color=darkblue]Dim[/color] wksDest [color=darkblue]As[/color] Worksheet
    [color=darkblue]Dim[/color] Cell [color=darkblue]As[/color] Range
    [color=darkblue]Dim[/color] FoundCells [color=darkblue]As[/color] Range
    [color=darkblue]Dim[/color] FirstAddress [color=darkblue]As[/color] [color=darkblue]String[/color]
    
    [color=darkblue]Set[/color] wksSource = Worksheets("Sheet1")  [color=green]'change the source sheet name accordingly[/color]
    [color=darkblue]Set[/color] wksDest = Worksheets("Sheet2")     [color=green]'change the destination sheet name accordingly[/color]
    
    [color=darkblue]With[/color] wksSource
        [color=darkblue]With[/color] .Range("A1", .Cells(.Rows.Count, "A").End(xlUp))
            [color=darkblue]Set[/color] Cell = .Find(what:="abc", LookIn:=xlValues, lookat:=xlPart, MatchCase:=False)
            [color=darkblue]If[/color] [color=darkblue]Not[/color] Cell [color=darkblue]Is[/color] [color=darkblue]Nothing[/color] [color=darkblue]Then[/color]
                FirstAddress = Cell.Address
                [color=darkblue]Do[/color]
                    [color=darkblue]If[/color] FoundCells [color=darkblue]Is[/color] [color=darkblue]Nothing[/color] [color=darkblue]Then[/color]
                        [color=darkblue]Set[/color] FoundCells = Cell
                    [color=darkblue]Else[/color]
                        [color=darkblue]Set[/color] FoundCells = Union(FoundCells, Cell)
                    [color=darkblue]End[/color] [color=darkblue]If[/color]
                    [color=darkblue]Set[/color] Cell = .FindNext(Cell)
                [color=darkblue]Loop[/color] [color=darkblue]While[/color] Cell.Address <> FirstAddress
            [color=darkblue]Else[/color]
                MsgBox "Search term was not found...", vbExclamation
                [color=darkblue]Exit[/color] [color=darkblue]Sub[/color]
            [color=darkblue]End[/color] [color=darkblue]If[/color]
        [color=darkblue]End[/color] [color=darkblue]With[/color]
    [color=darkblue]End[/color] [color=darkblue]With[/color]
        
    FoundCells.Copy wksDest.Range("A1")
    
    MsgBox "Completed...", vbInformation

[color=darkblue]End[/color] [color=darkblue]Sub[/color]
[/font]

Actually, if you make sure that Column A contains a header, you can use AutoFilter instead...

[font=Verdana][color=darkblue]Option[/color] [color=darkblue]Explicit[/color]

[color=darkblue]Sub[/color] test2()

    [color=darkblue]Dim[/color] wksSource [color=darkblue]As[/color] Worksheet
    [color=darkblue]Dim[/color] wksDest [color=darkblue]As[/color] Worksheet
    
    [color=darkblue]Set[/color] wksSource = Worksheets("Sheet1")  [color=green]'change the source sheet name accordingly[/color]
    [color=darkblue]Set[/color] wksDest = Worksheets("Sheet2")     [color=green]'change the destination sheet name accordingly[/color]
    
    Application.ScreenUpdating = [color=darkblue]False[/color]
    
    [color=darkblue]With[/color] wksSource
        [color=darkblue]With[/color] .Range("A1", .Cells(.Rows.Count, "A").End(xlUp))
            .AutoFilter field:=1, Criteria1:="*abc*"
            .Copy wksDest.Cells(1, 1)
            .AutoFilter
        [color=darkblue]End[/color] [color=darkblue]With[/color]
    [color=darkblue]End[/color] [color=darkblue]With[/color]
    
    Application.ScreenUpdating = [color=darkblue]True[/color]
    
    MsgBox "Completed...", vbInformation
    
[color=darkblue]End[/color] [color=darkblue]Sub[/color][/font]

 

[Eraengineer]

You are the Man! The second option works great! Now can we add yet another step? Lets say instead of filtering column A we place the info in column C and if that cell contains abc then it not only copies that cell but it copies the two cells to the left, cell B, Cell A and places those on sheet2 as well. I was thinking I needed to add Range("C1").offset(0-1).copy paste and Range("C1").offset(0-2).copy and then paste, well at least something to that nature.

 

[Domenic]

Try replacing...

    With wksSource
        With .Range("A1", .Cells(.Rows.Count, "A").End(xlUp))
            .AutoFilter field:=1, Criteria1:="*abc*"
            .Copy wksDest.Cells(1, 1)
            .AutoFilter
        End With
    End With

with

[font=Verdana]    [color=darkblue]With[/color] wksSource
        [color=darkblue]With[/color] .Range("A1", .Cells(.Rows.Count, "C").End(xlUp))
            .AutoFilter field:=3, Criteria1:="*abc*"
            .Copy wksDest.Cells(1, 1)
            .AutoFilter
        [color=darkblue]End[/color] [color=darkblue]With[/color]
    [color=darkblue]End[/color] [color=darkblue]With[/color][/font]

 

[Eraengineer]

I'm sure that works but I had to use the first example without the filter since the header was giving me issues with my code that finds the first empty line and pastes in that empty cell.
What would you do to copy the cells to the left with test1?

 

[Eraengineer]

FoundCells.Copy wksDest.Range("F1")
FoundCells.Offset(0, -1).Copy wksDest.Range("E1")
FoundCells.Offset(0, -2).Copy wksDest.Range("D1")
FoundCells.Offset(0, -3).Copy wksDest.Range("C1")
FoundCells.Offset(0, -4).Copy wksDest.Range("B1")
FoundCells.Offset(0, -5).Copy wksDest.Range("A1")

MsgBox "Completed...", vbInformation

I just used this and I think it works fine...

 

[Domenic]

Here's the same thing, but expressed differently...

With FoundCells
    .Copy wksDest.Range("F1")
    .Offset(0, -1).Copy wksDest.Range("E1")
    .Offset(0, -2).Copy wksDest.Range("D1")
    .Offset(0, -3).Copy wksDest.Range("C1")
    .Offset(0, -4).Copy wksDest.Range("B1")
    .Offset(0, -5).Copy wksDest.Range("A1")
End With

Or, simply...

FoundCells.EntireRow.Copy wksDest.Range("A1")