skip worksheet if pattern not found-CodePudding

I have a multiple worksheet Excel file.

I want to copy a range enclosed between cells with the values "start" and "next" from each worksheet to a "master" worksheet. This range will be at different addresses for each sheet.

I want my macro to skip every worksheet that matches either of these conditions:

there is no cell "start"
there is no cell "next"
the cells "start" and "next" are not in the same column

My code works so far but I don't know how to set up the conditions. Any help is much appreciated.

cheers

Sub find_copy()

    Dim startCell As String
    Dim endCell As String
    Dim selectionRange As String
    Dim ws As Worksheet
    
    Application.ScreenUpdating = False
        
    For Each ws In ActiveWorkbook.Worksheets
        If ws.Name <> "master" Then
            
            'find Range by keywords
            startCell = ws.Cells.Find(what:="start").Offset(1, 0).Address
            endCell = ws.Cells.Find(what:="next").Offset(-3, 0).Address
            selectionRange = startCell & ":" & endCell
        
            'copy Range to master
            ws.Range(selectionRange).Copy Sheets("master").Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1)
        End If
    Next

    Application.ScreenUpdating = True
    
End Sub

CodePudding user response：

I would use a helper/try function to retrieve the according ranges:

Private Function tryFindCell(ws As Worksheet, strWhat As String, _
    rg As Range) As Boolean

Set rg = ws.Cells.Find(what:=strWhat)
If Not rg Is Nothing Then tryFindCell = True

End Function

It returns false if the cell wasn't found.

You will use it in your sub like this:

Sub find_copy()

    Dim rgKeyWordStart As Range, startCell As String
    Dim rgKeyWordNext As Range, endCell As String
    Dim selectionRange As String
    Dim ws As Worksheet
    
    Application.ScreenUpdating = False
        
    For Each ws In ActiveWorkbook.Worksheets
        If ws.Name <> "master" Then
            
            'find Range by keywords
            If tryFindCell(ws, "start", rgKeyWordStart) = False Then GoTo nextSheet
            If tryFindCell(ws, "next", rgKeyWordNext) = False Then GoTo nextSheet
            If rgKeyWordStart.Column <> rgKeyWordNext.Column Then GoTo nextSheet
            
            startCell = rgKeyWordStart.Offset(1, 0).Address
            endCell = rgKeyWordEnd.Offset(-3, 0).Address
            selectionRange = startCell & ":" & endCell
        
            'copy Range to master
            ws.Range(selectionRange).Copy Sheets("master").Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1)
        End If
nextSheet:
    Next

    Application.ScreenUpdating = True
    
End Sub