Excel VBA Macro To Conditional Delete Rows Across Multiple Sheets

I have the following macro below

The macro is working well except for the code to delete rows. Rows 2:8 must only be deleted on those sheets where "Mens Shoe Department" appears in B3 , except sheet "Data"

Code:

---

Sub Cleanup_Data()
    Dim Sh As Worksheet
    Dim LR As Long
    For Each Sh In ActiveWorkbook.Worksheets
     

        If Sh.Name <> "Data" Then
            With Sh
         
                LR = .Cells(.Rows.Count, "B").End(xlUp).Row
                .Range("A1:A" & LR).Replace What:="|", Replacement:="", LookAt:=xlWhole
                .Range("C1:H" & LR).Replace What:="|", Replacement:="", LookAt:=xlWhole
                .Range("C1:H" & LR).Replace What:="v", Replacement:="", LookAt:=xlWhole
                .Range("C1:H" & LR).Replace What:="p", Replacement:="", LookAt:=xlWhole
                .Range("C1:H" & LR).Replace What:="s", Replacement:="", LookAt:=xlWhole
                .Range("C1:H" & LR).Replace What:="f", Replacement:="", LookAt:=xlWhole
                .Range("B1:H" & LR).Replace What:="-", Replacement:="", LookAt:=xlWhole
                .Range("E1:E" & LR).Replace What:="?", Replacement:="", LookAt:=xlWhole
                .Range("E1:E" & LR).Replace What:="I", Replacement:="", LookAt:=xlWhole
                .Range("C1:D" & LR).ClearContents
                  .Range("G1:G" & LR).ClearContents
                  End With
                  If InStr(Range("B10").Value, "MENS SHOES DEPARTMENT") < 0 Then
                  Range("A2:A8").EntireRow.Delete
               
        End If
        End If
    Next Sh
End Sub

---

Assistance in resolving this is most appreciated

Code:

---

Sub Cleanup_Data()
   
    Dim Sh As Worksheet
    Dim LR As Long
    For Each Sh In ActiveWorkbook.Worksheets
        If Sh.Name <> "Data" Then
            With Sh
                LR = .Cells(.Rows.Count, "B").End(xlUp).Row
                .Range("A1:A" & LR & ",C1:H" & LR).Replace What:="|", Replacement:="", LookAt:=xlWhole
                .Range("C1:H" & LR).Replace What:="v", Replacement:="", LookAt:=xlWhole
                .Range("C1:H" & LR).Replace What:="p", Replacement:="", LookAt:=xlWhole
                .Range("C1:H" & LR).Replace What:="s", Replacement:="", LookAt:=xlWhole
                .Range("C1:H" & LR).Replace What:="f", Replacement:="", LookAt:=xlWhole
                .Range("B1:H" & LR).Replace What:="-", Replacement:="", LookAt:=xlWhole
                .Range("E1:E" & LR).Replace What:="?", Replacement:="", LookAt:=xlWhole
                .Range("E1:E" & LR).Replace What:="I", Replacement:="", LookAt:=xlWhole
                .Range("C1:D" & LR & ",G1:G" & LR).ClearContents
                If InStr(.Range("B10").Value, "MENS SHOES DEPARTMENT") < 0 Then
                    .Range("A2:A8").EntireRow.Delete
                End If
            End With
        End If
    Next Sh
   
End Sub

---

Thanks for the help. Where Mens Shoes Department" appears in B10, Rows 2:8 are not being deleted

See sample per link below


https://www.dropbox.com/s/fn4fxhytjt...olidation.xlsm

Kindly test & amend code

Hi Excelfox

Thanks for all your help

I managed to find the error.

Code:

---

  If InStr(.Range("B10").Value, "MENS SHOES DEPARTMENT") < 0 Then

---

This should be

Code:

---

  If InStr(.Range("B10").Value, "MENS SHOES DEPARTMENT") > 0 Then

---