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, Oct 05 '17 at 18:18
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, Oct 05 '17 at 18:21
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, Oct 05 '17 at 18:30
Wait - you want this to run on `ytd`, `ptd`, `qtr` and `mth`? — BruceWayne, Oct 05 '17 at 18:36
Yes, the solution you provided should work on ptd and ytd correct? This works beautifully. If I add code within the "With" block to remove additional columns that should be fine correct? Thanks so much — Shin, Oct 05 '17 at 18:39
See my edit - if you need it on those four, the edited code is shorter, but does that on all the sheets that you did NOT duplicate (as long as there's no `(` in the sheet name, the row removal stuff will run on it). And yes, add more code within the `With` block but **be sure** to reference the `With ws` by adding the `.` before your ranges, like I did with `.Range()`. — BruceWayne, Oct 05 '17 at 18:42
One more quick question, if I want to delete the second row from this shortened list wouldn't it be: .Range(Rows(2)).EntireRow.Delete? I keep getting returned errors when I try to delete another row and when i try to copy/paste cells — Shin, Oct 05 '17 at 19:33
sorry that is what i meant - I end up getting an error 'argument not optional' — Shin, Oct 05 '17 at 21:52
If you want to delete the second row, it should just be `.Rows(2).EntireRow.Delete`. No need to wrap `Rows()` in `Range()`. — BruceWayne, Oct 05 '17 at 21:58

BruceWayne · Accepted Answer · 2017-10-05T18:41:48.813

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 Answers1