Search For A String. Then Copy All Cells Between Each Occurrence

Re: Search For A String. Then Copy All Cells Between Each Occurence

This code will select all numeric cells in 1-st column:

Columns(1).SpecialCells(xlCellTypeConstants,xlNumbers).Select

Re: Search For A String. Then Copy All Cells Between Each Occurrence

This will take information from column A and paste in column B
[vba]Sub x()

Dim rngTemp As Range
Dim rngFind As Range
Dim rngFirst As Range
Dim rngLast As Range
Dim strFirstAddress As String
Dim lngRow As Long

lngRow = Range("A" & Rows.Count).End(xlUp).Row + 1
With Range("A:A")
Set rngFind = .Find("spot.return", .Cells(lngRow, 1), LookIn:=xlValues, lookat:=xlWhole)
If Not rngFind Is Nothing Then
strFirstAddress = rngFind.Address
Set rngFirst = rngFind.Offset(1)
Set rngTemp = rngFirst
Set rngFind = .FindNext(rngFind)
Do While Not rngFind Is Nothing And rngFind.Address <> strFirstAddress
Set rngLast = rngFind.Offset(-1)
Set rngTemp = Union(rngTemp, Range(rngFirst, rngLast))
Set rngFirst = rngFind.Offset(1)
Set rngFind = .FindNext(rngFind)
Loop
End If
End With
rngTemp.Copy Range("B1")
End Sub[/vba]

Re: Search For A String. Then Copy All Cells Between Each Occurrence

You can use Advanced Filter to copy filtered values to another place. This macro can do it for you:

Sub FilterToRange()
    Dim xlInitialCalcState As XlCalculation
    Dim rngCrit As Range, rngResult As Range
    Dim lngLastRow As Long, lngColCount As Long


    With Application
        .ScreenUpdating = False
        xlInitialCalcState = .Calculation
        .Calculation = xlCalculationManual


        lngColCount = ActiveSheet.UsedRange.Columns.Count


        Set rngCrit = Cells(1, lngColCount + 2).Resize(2)
        rngCrit(1).Value = Cells(1, 1).Value
        rngCrit(2).Value = "<>spot.return"


        Set rngResult = Cells(1, lngColCount + 1)


        Range(Cells(1, 1), Cells(Rows.Count, 1).End(xlUp)).AdvancedFilter _
                Action:=xlFilterCopy, _
                CriteriaRange:=rngCrit, _
                CopyToRange:=rngResult


        rngCrit.ClearContents
        rngResult(1).Delete


        .Calculation = xlInitialCalcState
        .ScreenUpdating = True
    End With
End Sub

Re: Search For A String. Then Copy All Cells Between Each Occurrence

Dim a, e, b(), i As Long, n As Long
a = Range("a1",Range("a" & Rows.Count).End(xlUp)).Value
ReDim b(1 To UBound(a,1), 1 To 1)
For Each e In a
     If (UCase(e) <> "SPOT.RETURN") * (e <> "") Then
          n = n + 1 : b(n,1) = e
     End If
Next
Range("b1").Resize(n).Value = b
End Sub

Re: Search For A String. Then Copy All Cells Between Each Occurrence

Quote from khalel04

Thanks guys for the reply. I've tried all but nothing seems to work.

Hi Jindon,

script you made, it just copied the whole data into column B.
Regards,
khalel04

That means your questioned text is not "Spot.Return"

You must tell us exactly what it is.

Re: Search For A String. Then Copy All Cells Between Each Occurrence

Quote from khalel04

Hi Jindon/the OKK,

Both script you made, it just copied the whole data into column B.

Try this one:

Sub FilterToRange() 
    Dim xlInitialCalcState As XlCalculation 
    Dim rngCrit As Range, rngResult As Range 
    Dim lngLastRow As Long, lngColCount As Long 
     
    With Application 
        .ScreenUpdating = False 
        xlInitialCalcState = .Calculation 
        .Calculation = xlCalculationManual 
         
        lngColCount = ActiveSheet.UsedRange.Columns.Count 
         
        Set rngCrit = Cells(1, lngColCount + 2).Resize(2) 
        rngCrit(1).Value = Cells(1, 1).Value 
        rngCrit(2).Value = "<>" & rngCrit(1).Value
         
        Set rngResult = Cells(1, lngColCount + 1) 
         
        Range(Cells(1, 1), Cells(Rows.Count, 1).End(xlUp)).AdvancedFilter _ 
        Action:=xlFilterCopy, _ 
        CriteriaRange:=rngCrit, _ 
        CopyToRange:=rngResult 
         
        rngCrit.ClearContents 
        rngResult(1).Delete 
         
        .Calculation = xlInitialCalcState 
        .ScreenUpdating = True 
    End With 
End Sub

Re: Search For A String. Then Copy All Cells Between Each Occurrence

Dim a, e, b(), i As Long, n As Long
a = Range("a1",Range("a" & Rows.Count).End(xlUp)).Value
ReDim b(1 To UBound(a,1), 1 To 1)
For Each e In a
     If (InStr(1,e,"spot.return",1)<>1) * (e <> "") Then
          n = n + 1 : b(n,1) = e
     End If
Next
Range("b1").Resize(n).Value = b
End Sub

Re: Search For A String. Then Copy All Cells Between Each Occurrence

This revision should allow finding of spot.return within a cell.
And the copy will only occur if the range has something to be copied

[vba]
Sub x()

Dim rngTemp As Range
Dim rngFind As Range
Dim rngFirst As Range
Dim rngLast As Range
Dim strFirstAddress As String
Dim lngRow As Long

lngRow = Range("A" & Rows.Count).End(xlUp).Row + 1
With Range("A:A")
Set rngFind = .Find("spot.return", .Cells(lngRow, 1), LookIn:=xlValues, lookat:=xlPart)
If Not rngFind Is Nothing Then
strFirstAddress = rngFind.Address
Set rngFirst = rngFind.Offset(1)
Set rngTemp = rngFirst
Set rngFind = .FindNext(rngFind)
Do While Not rngFind Is Nothing And rngFind.Address <> strFirstAddress
Set rngLast = rngFind.Offset(-1)
Set rngTemp = Union(rngTemp, Range(rngFirst, rngLast))
Set rngFirst = rngFind.Offset(1)
Set rngFind = .FindNext(rngFind)
Loop
End If
End With
If Not rngTemp Is Nothing Then rngTemp.Copy Range("B1")
End Sub[/vba]