=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!?

 

[Eraengineer]

Dom I tried copying the test1 code and pasting it under itself so that I can run the same code again but instead of ABC it would run DEF. But as I check the DEF sheet the cells are off because in the column the search is being performed it copies the formula. This doesn't occur in sheet ABC... This has me stumped.
This is the code as I am using it.

'sort by process LZS
Dim wksSource As Worksheet
Dim wksDest As Worksheet
Dim Cell As Range
Dim FoundCells As Range
Dim FirstAddress As String

Set wksSource = Worksheets("Planner") 'change the source sheet name accordingly
Set wksDest = Worksheets("LZSB") 'change the destination sheet name accordingly

With wksSource
With .Range("F1", .Cells(.Rows.Count, "F").End(xlUp))
Set Cell = .Find(what:="LZS", LookIn:=xlValues, lookat:=xlPart, MatchCase:=False)

If Not Cell Is Nothing Then
FirstAddress = Cell.Address
Do
If FoundCells Is Nothing Then
Set FoundCells = Cell
Else
Set FoundCells = Union(FoundCells, Cell)
End If
Set Cell = .FindNext(Cell)
Loop While Cell.Address <> FirstAddress
Else
MsgBox "Search term was not found...", vbExclamation
Exit Sub
End If
End With
End With

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")


Set wksDest = Worksheets("PRBB") 'change the destination sheet name accordingly

With wksSource
With .Range("F1", .Cells(.Rows.Count, "F").End(xlUp))
Set Cell = .Find(what:="PRB", LookIn:=xlValues, lookat:=xlPart, MatchCase:=False)

If Not Cell Is Nothing Then
FirstAddress = Cell.Address
Do
If FoundCells Is Nothing Then
Set FoundCells = Cell
Else
Set FoundCells = Union(FoundCells, Cell)
End If
Set Cell = .FindNext(Cell)
Loop While Cell.Address <> FirstAddress
Else
MsgBox "Search term was not found...", vbExclamation
Exit Sub
End If
End With
End With

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")

MsgBox "Completed...", vbInformation

 

[Domenic]

Try...

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

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

    [color=darkblue]Dim[/color] wksSource [color=darkblue]As[/color] Worksheet
    [color=darkblue]Dim[/color] MyDestSheets [color=darkblue]As[/color] [color=darkblue]Variant[/color]
    [color=darkblue]Dim[/color] MyValues [color=darkblue]As[/color] [color=darkblue]Variant[/color]
    [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]Dim[/color] i [color=darkblue]As[/color] [color=darkblue]Long[/color]
    
    Application.ScreenUpdating = [color=darkblue]False[/color]
    
    MyDestSheets = Array("LZSB", "PRBB")
    MyValues = Array("LZS", "PRB")
    
    [color=darkblue]Set[/color] wksSource = Worksheets("Planner")
        
    [color=darkblue]With[/color] wksSource
        [color=darkblue]With[/color] .Range("F1", .Cells(.Rows.Count, "F").End(xlUp))
            [color=darkblue]For[/color] i = [color=darkblue]LBound[/color](MyValues) [color=darkblue]To[/color] [color=darkblue]UBound[/color](MyValues)
                [color=darkblue]Set[/color] Cell = .Find(what:=MyValues(i), 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]With[/color] Worksheets(MyDestSheets(i))
                        FoundCells.Copy
                        .Range("F1").PasteSpecial xlPasteValues
                        FoundCells.Offset(0, -1).Copy
                        .Range("E1").PasteSpecial xlPasteValues
                        FoundCells.Offset(0, -2).Copy
                        .Range("D1").PasteSpecial xlPasteValues
                        FoundCells.Offset(0, -3).Copy
                        .Range("C1").PasteSpecial xlPasteValues
                        FoundCells.Offset(0, -4).Copy
                        .Range("B1").PasteSpecial xlPasteValues
                    [color=darkblue]End[/color] [color=darkblue]With[/color]
                    [color=darkblue]Set[/color] FoundCells = [color=darkblue]Nothing[/color]
                [color=darkblue]End[/color] [color=darkblue]If[/color]
            [color=darkblue]Next[/color] i
        [color=darkblue]End[/color] [color=darkblue]With[/color]
    [color=darkblue]End[/color] [color=darkblue]With[/color]
    
    Application.CutCopyMode = [color=darkblue]False[/color]
    
    Application.ScreenUpdating = [color=darkblue]True[/color]
    
    MsgBox "Completed...", vbInformation

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

 

[Eraengineer]

Im getting a compile error: End With without With...

 

[Eraengineer]

Nevermind I opened this on my phone and it cut lines off....

 

[Eraengineer]

Dom where did you pick all of this up from?

 

[Domenic]

Dom where did you pick all of this up from?

I'm learning by doing some reading and by participating in this forum. It's a great place to learn.