Select multiple ranges between two same words in one column

[Sathish G]

Sub SelectmultipleBetween()
Sheets("sheet1").Select
Dim findrow As Long, findrow2 As Long
findrow = Range("B:B").Find("idle").Row
findrow2 = Range("B:B").Find("proc", Range("B" & findrow)).Row
Range("B" & findrow + 1 & ":B" & findrow2 - 1).Select
Selection.Copy
Sheets("sheet2").Select


Range("C1").Select


ActiveSheet.Paste



Sheets("sheet1").Select
findrow = Range("B:B").Find("idle").Row
MatchCase:=False, SearchFormat:=False).Activate
findrow2 = Range("B:B").Find("proc", Range("B" & findrow)).Row
Range("B" & findrow + 1 & ":B" & findrow2 - 1).Select
Selection.Copy


Sheets("sheet2").Select


Range("D1").Select


ActiveSheet.Paste

Sheets("sheet1").Select
findrow = Range("B:B").Find("idle").Row
MatchCase:=False, SearchFormat:=False).Activate
findrow2 = Range("B:B").Find("proc", Range("B" & findrow)).Row
Range("B" & findrow + 1 & ":B" & findrow2 - 1).Select
Selection.Copy


Sheets("sheet2").Select


Range("E1").Select


ActiveSheet.Paste

Sheets("sheet1").Select
findrow = Range("B:B").Find("idle").Row
MatchCase:=False, SearchFormat:=False).Activate
findrow2 = Range("B:B").Find("proc", Range("B" & findrow)).Row
Range("B" & findrow + 1 & ":B" & findrow2 - 1).Select
Selection.Copy


Sheets("sheet2").Select


Range("F1").Select


ActiveSheet.Paste


End Sub

Am new to VBA please help to select multiple ranges in same columns

This is not working to pick multiple ranges its only taking 1st range from the column

 

[gallen]

Re: How to select multiple ranges between two same words in one column

Hello and welcome.

In your code you always paste to columns C,D,E & F of sheet2. Will there ALWAYS only be 4 selections to paste?

 

[Sathish G]

Re: How to select multiple ranges between two same words in one column

Hello and welcome.

In your code you always paste to columns C,D,E & F of sheet2. Will there ALWAYS only be 4 selections to paste?

Yes only 4 selections wants to paste in sheet2

 

[gallen]

Re: How to select multiple ranges between two same words in one column

Hello, this code is flexible so if there is only one section it will only paste 1, up to however many you may have.

Make sure you test on a COPY of your data

It's quite different to your original code so I've commented what is happening to help you understand

Sub SelectmultipleBetween()
    
Dim rFind As Range, rFind2 As Range, rSearch As Range
Dim lr As Long, iCol As Long

'Variables to store the first found address
Dim sFirstAddress As String, sFirstAddress2 As String

    iCol = 3 'First column to paste to = "C"

    lr = Sheet1.Range("B" & Rows.Count).End(xlUp).Row
    
    'Search range is B1 to last used row in column B
    Set rSearch = Sheet1.Range("B1:B" & lr)
    Set rSearch2 = Sheet1.Range("B1:B" & lr)
    
    'Now find the first keyword IDLE
    Set rFind = rSearch.Find("idle")
    
    'Handle what happens if it isn't found
    If rFind Is Nothing Then
        MsgBox "IDLE Not found", vbExclamation, "IDLE Not Found"
        Exit Sub
    End If
    
    'Remember the first instance of IDLE's address
    sFirstAddress = rFind.Address
    
    'Now find the first instance of PROC
    Set rFind2 = rSearch.Find(What:="proc", After:=rFind)
    
    If rFind2 Is Nothing Then
        MsgBox "PROC Not found", vbExclamation, "PROC Not Found"
        Exit Sub
    ElseIf rFind2.Row < rFind.Row Then 'PROC was only found BEFORE IDLE
        MsgBox "PROC found but only BEFORE IDLE", vbExclamation, "Error"
        Exit Sub
    End If
    
    'Remember the first instance of PROC's address
    sFirstAddress2 = rFind2.Address
    
    'Copy the range and past to column "C" of sheet 2
    Sheet1.Range(rFind.Offset(1), rFind2.Offset(-1)).Copy Sheet2.Cells(1, iCol)
    
    'increment iCol
    iCol = iCol + 1
    
    'keep going, finding every instance of PROC and IDLE until we are back to our first instance
    Do
        'Find next instance IDLE
        Set rFind = rSearch.Find(What:="idle", After:=rFind)
        
        'If we are back to first instance, exit Loop
        If rFind.Address = sFirstAddress Then Exit Do
        
        'Find Next instance of PROC
        Set rFind2 = rSearch.Find(What:="proc", After:=rFind)
        
        'Next instance is same as first so exit loop
        If rFind2.Address = sFirstAddress2 Then Exit Do
        
        'Copy the range and past to next column of sheet 2
        Sheet1.Range(rFind.Offset(1), rFind2.Offset(-1)).Copy Sheet2.Cells(1, iCol)
        
        'increment iCol
        iCol = iCol + 1
    Loop


End Sub

 

[Sathish G]

Re: How to select multiple ranges between two same words in one column

Hi friend given formula is not copy/pasting in sheet2

 

[gallen]

Re: How to select multiple ranges between two same words in one column

Hi friend given formula is not copy/pasting in sheet2

This can only occur if you have named your sheets Sheet1 and Sheet 2 but they have different object names. This code uses the sheet name not object name:

Sub SelectmultipleBetween()
    
Dim rFind As Range, rFind2 As Range, rSearch As Range
Dim lr As Long, iCol As Long


'Variables to store the first found address
Dim sFirstAddress As String, sFirstAddress2 As String


    iCol = 3 'First column to paste to = "C"


    lr = Sheets("Sheet1").Range("B" & Rows.Count).End(xlUp).Row
    
    'Search range is B1 to last used row in column B
    Set rSearch = Sheets("Sheet1").Range("B1:B" & lr)
    Set rSearch2 = Sheets("Sheet1").Range("B1:B" & lr)
    
    'Now find the first keyword IDLE
    Set rFind = rSearch.Find("idle")
    
    'Handle what happens if it isn't found
    If rFind Is Nothing Then
        MsgBox "IDLE Not found", vbExclamation, "IDLE Not Found"
        Exit Sub
    End If
    
    'Remember the first instance of IDLE's address
    sFirstAddress = rFind.Address
    
    'Now find the first instance of PROC
    Set rFind2 = rSearch.Find(What:="proc", After:=rFind)
    
    If rFind2 Is Nothing Then
        MsgBox "PROC Not found", vbExclamation, "PROC Not Found"
        Exit Sub
    ElseIf rFind2.Row < rFind.Row Then 'PROC was only found BEFORE IDLE
        MsgBox "PROC found but only BEFORE IDLE", vbExclamation, "Error"
        Exit Sub
    End If
    
    'Remember the first instance of PROC's address
    sFirstAddress2 = rFind2.Address
    
    'Copy the range and past to column "C" of sheet 2
    Sheets("Sheet1").Range(rFind.Offset(1), rFind2.Offset(-1)).Copy Sheets("Sheet2").Cells(1, iCol)
    
    'increment iCol
    iCol = iCol + 1
    
    'keep going, finding every instance of PROC and IDLE until we are back to our first instance
    Do
        'Find next instance IDLE
        Set rFind = rSearch.Find(What:="idle", After:=rFind)
        
        'If we are back to first instance, exit Loop
        If rFind.Address = sFirstAddress Then Exit Do
        
        'Find Next instance of PROC
        Set rFind2 = rSearch.Find(What:="proc", After:=rFind)
        
        'Next instance is same as first so exit loop
        If rFind2.Address = sFirstAddress2 Then Exit Do
        
        'Copy the range and past to next column of sheet 2
        Sheets("Sheet1").Range(rFind.Offset(1), rFind2.Offset(-1)).Copy Sheets("Sheet2").Cells(1, iCol)
        
        'increment iCol
        iCol = iCol + 1
    Loop


End Sub

 

[Sathish G]

Re: How to select multiple ranges between two same words in one column

Great! working good thank you so much.

 

[gallen]

Re: How to select multiple ranges between two same words in one column

There is a line of code in there that I forgot to delete. It won't create an error unless you have Option Explicit but it can be safely deleted:

[COLOR=#333333]Set rSearch2 = Sheets("Sheet1").Range("B1:B" & lr)[/COLOR]