Loop to Cut and Paste Between Two String Occurrences

[bmacias]

Hope I can explain myself clearly on this one.

Starting on cell A2, I'm trying to create a loop that checks the cell value and if it equals "Texas" select the range of cells between the next occurrence of the word "Texas", cut the range and move it column "H". The loop would continue would then select the cells between the 2nd and 3rd Instance of the word "Texas" and move that text to column "H". The values of the cells in between varies but they will not go past column "F". Please see attached pic to see if I'm making sense. My actual database is thousands and thousand rows long, hence my reaching out for help.

Thank you in advance.

Ben

 

[Trebor76]

Hi bmacias,

Try this:

Option Explicit
Sub Macro1()

    Dim wsSrc As Worksheet
    Dim lngLastRow As Long
    Dim rng As Range
    
    Application.ScreenUpdating = False
    
    Set wsSrc = ThisWorkbook.Sheets("Sheet1") 'Sheet name with the data. Change to suit if necessary.
    
    With wsSrc
        On Error Resume Next
            .ShowAllData
        On Error GoTo 0
        .Columns.EntireColumn.Hidden = False
        .Rows.EntireRow.Hidden = False
        lngLastRow = .Range("A:F").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        Range(.Cells(2, 1), .Cells(lngLastRow, 6)).Copy Destination:=.Range("H2")
        With wsSrc.Columns("H") 'https://www.mrexcel.com/board/threads/replace-a-word-with-nothing-vba.1149029
            .Replace What:="Texas", _
                            Replacement:="", _
                            LookAt:=xlPart, _
                            SearchOrder:=xlByRows, _
                            MatchCase:=False, _
                            SearchFormat:=False, _
                            ReplaceFormat:=False
            
        End With
    End With
    
    Application.ScreenUpdating = True

End Sub

Regards,

Robert

 

[bmacias]

Thank you Trebor76, it works beautifully.

​

 

[Trebor76]

Thank you Trebor76, it works beautifully.

Thanks for letting us know and you're welcome