Removing all rows that contain specific text over multiple sheets

Question

I have four sheets with raw data that I would like to be duplicated in my workbook and left alone for cross reference. Then I would like to remove all rows above the cell with the text "proj def" (it appears twice, but there are cells that lie in between the two appearances - which will be evident in my code). I would like to do this for the first four sheets of my workbook while leaving the original duplicated worksheets alone but am only able to do so with the first worksheet labeled "ptd". I have tried to activate the next worksheet "ytd" and even delete the original worksheet "ptd" to see if it would allow me to change the location of myRange but I have had no success. Essentially I want to run this code in sub methods, two for the first sheet "ptd", two more for the second sheet "ytd", another 2 for "qtr" and the final 2 for "mth". Any edits to my sample code would be much appreciated.

Sub part1()
    Worksheets("ptd").Copy After:=Worksheets("mth")
    Worksheets("ytd").Copy After:=Worksheets("ptd (2)")
    Worksheets("qtr").Copy After:=Worksheets("ytd (2)")
    Worksheets("mth").Copy After:=Worksheets("qtr (2)")
End Sub
Sub part2()
Worksheets("ptd").Activate
Set rngActiveRange = ActiveCell
            Dim MyRange As Range
            Set MyRange = ActiveSheet.Range("A:A")
            MyRange.Find("Customer Unit", LookIn:=xlValues).Select
            rngActiveRange.Offset(-1, 0).Select
            Range(rngActiveRange.Row & ":" & 1).Rows.Delete
End Sub
Sub part3()
    Dim MyRange As Range
    Set MyRange = ActiveSheet.Range("A:A")
    MyRange.Find("Project Definition", LookIn:=xlValues).Select
    ActiveCell.Offset(-1, 0).Select
    Range(ActiveCell.Row & ":" & 1).Rows.Delete
End Sub
Sub part4()
Worksheets("ytd").Activate
Set rngActiveRange = ActiveCell
            Dim MyRange As Range
            Set MyRange = ActiveSheet.Range("A:A")
            MyRange.Find("Customer Unit", LookIn:=xlValues).Select
            rngActiveRange.Offset(-1, 0).Select
            Range(rngActiveRange.Row & ":" & 1).Rows.Delete
End Sub
Sub part5()
    Dim MyRange As Range
    Set MyRange = ActiveSheet.Range("A:A")
    MyRange.Find("Project Definition", LookIn:=xlValues).Select
    ActiveCell.Offset(-1, 0).Select
    Range(ActiveCell.Row & ":" & 1).Rows.Delete
End Sub

What's the ActiveCell when you activate each sheet? Do you want to remove all rows where those words appear, starting from the bottom up? — BruceWayne
If "Customer Unit" is in A26 and A199, do you want to remove all rows from 1:198? Edit: Wait, you have Customer Unit and Project Definition in both sheets. You want to remove the rows before Customer Unit, then remove the rows before Project Definition after you removed the rows before Customer Unit, yes? Do I understand that correctly? — BruceWayne
Yes that is correct, it is my method of removing all rows before Project Definition the 2nd time it occurs. I have to do it like that because it occurs in different cell locations across the four worksheets. — Shin
Wait - you want this to run on ytd, ptd, qtr and mth? — BruceWayne

BruceWayne BruceWayne · Accepted Answer · 2017-10-05T18:28:46

If I understand correctly, the below should work. The main thing I did was re-write with avoiding the use of .Select/.Activate.

Sub remove_Rows()
Dim ws      As Worksheet
Dim foundCel As Range

' Copy sheets
Worksheets("ptd").Copy After:=Worksheets("mth")
Worksheets("ytd").Copy After:=Worksheets("ptd (2)")
Worksheets("qtr").Copy After:=Worksheets("ytd (2)")
Worksheets("mth").Copy After:=Worksheets("qtr (2)")

' Start removing rows
For Each ws In ActiveWorkbook.Worksheets
    With ws
        If InStr(1, .Name, "(") = 0 Then
            Set foundCel = .Range("A:A").Find("Customer Unit", LookIn:=xlValues)
            .Range(foundCel.Offset(-1, 0).Row & ":" & 1).Rows.Delete
            Set foundCel = .Range("A:A").Find("Project Definition", LookIn:=xlValues)
            .Range(foundCel.Offset(-1, 0).Row & ":" & 1).Rows.Delete
        End If
    End With
Next ws

End Sub

Removing all rows that contain specific text over multiple sheets

1 Answers