Excel VBA Macro To Conditional Delete Rows Across Multiple Sheets

[Flupsie]

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"

 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

[Excel Fox]

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

[Flupsie]

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

[Flupsie]

Hi Excelfox

Thanks for all your help

I managed to find the error.

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

This should be

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