if match found delete from Multiple sheets |excel|VBA|

[jackbhai]

Sheet 0 : https://paste.pics/82a491cbc642d6fff555ef70612aec5b
Sheet 1 : https://paste.pics/cafe8628b76e56789cf03b06a923bde8
Sheet 2 : https://paste.pics/2320369d395a22c868b5e439b456ad3a
Sheet 3 : https://paste.pics/9fc84c7f43e1a2819d1537593c44c1f9


If match is found => "SUP" "AL" "AP" then Data should be cleared from all the sheets with one Button click
Button is in "Sheet0" => when clearing data the Headers should not get Cleared


if want to see my excel safe download 100%
https://drive.google.com/file/d/1w0n_srbhF02OhiWzKsB4IWWiwV5nO-Vl/view?usp=sharing


This is my code where i tried But not working


Private Sub CommandCreate_new_Click()
Dim Ws As Worksheet
For Each Ws In Sheets(Array("Sheet1","Sheet2","Sheet3"))
Ws.Range ("I9:AM9")
.Cells.Replace what:=UCase("SUP"), Replacement:="", ReplaceFormat:=True
.Cells.Replace what:=UCase("SUP"), Replacement:="", ReplaceFormat:=False
.Cells.Replace what:=UCase("AL"), Replacement:="", ReplaceFormat:=True
.Cells.Replace what:=UCase("AL"), Replacement:="", ReplaceFormat:=False
Next Ws
End Sub

 

[jackbhai]

i tried this one also

code => not working

[h=1]Private Sub CommandCreate_new_Click()
Dim Ws As Worksheet
For Each Ws In Sheets(Array("Sheet1","Sheet2","Sheet3"))
Ws.Range("A4", .Range("A" & Rows.Count).End(xlUp).Offset(, 1)).ClearContents
Ws.Range("B4", .Range("B" & Rows.Count).End(xlUp).Offset(, 1)).ClearContents
Ws.Range("C4", .Range("C" & Rows.Count).End(xlUp).Offset(, 1)).ClearContents
Ws.Range("D4", .Range("D" & Rows.Count).End(xlUp).Offset(, 1)).ClearContents
Ws.Range("E4", .Range("E" & Rows.Count).End(xlUp).Offset(, 1)).ClearContents
Ws.Range("F4", .Range("F" & Rows.Count).End(xlUp).Offset(, 1)).ClearContents
Ws.Range("G4", .Range("G" & Rows.Count).End(xlUp).Offset(, 1)).ClearContents
Ws.Range("H4", .Range("H" & Rows.Count).End(xlUp).Offset(, 1)).ClearContents
Ws.Range("I4", .Range("I" & Rows.Count).End(xlUp).Offset(, 1)).ClearContents
Ws.Range("J4", .Range("J" & Rows.Count).End(xlUp).Offset(, 1)).ClearContents
Next Ws
End Sub
[/h]

 

[DanteAmor]

Try this

Private Sub CommandCreate_new_Click()
    Dim Ws As Worksheet
    For Each Ws In Sheets(Array("Sheet1", "Sheet2", "Sheet3"))
        Ws.Range("A4:J" & Rows.Count).ClearContents
    Next Ws
End Sub

 

[jackbhai]

Not working Bro

it is not clearing all the data => i need to delete only match data

like "SUP" "AP" "AL" => if found clear the data of it and the cell to normal cell => no fill color

 

[DanteAmor]

Try this

Private Sub CommandCreate_new_Click()
    Dim Ws As Worksheet
    For Each Ws In Sheets(Array("Sheet1", "Sheet2", "Sheet3"))
        Ws.Range("A4:J" & Rows.Count).Replace What:="SUP", Replacement:="", LookAt:=xlWhole
        Ws.Range("A4:J" & Rows.Count).Replace What:="AP", Replacement:="", LookAt:=xlWhole
        Ws.Range("A4:J" & Rows.Count).Replace What:="AL", Replacement:="", LookAt:=xlWhole
    Next Ws
End Sub

Do you have conditional format in the cells?


If not, then

Private Sub CommandCreate_new_Click()
    Dim Ws As Worksheet, lr As Long, c As Range
    For Each Ws In Sheets(Array("Sheet1", "Sheet2", "Sheet3"))
        lr = Ws.UsedRange.Rows(ActiveSheet.UsedRange.Rows.Count).Row
        For Each c In Ws.Range("A4:J" & lr)
            Select Case UCase(c.Value)
                Case "SUP", "AP", "AL"
                    c.Value = ""
                    c.Interior.ColorIndex = xlNone
            End Select
        Next
    Next Ws
End Sub

 

[jackbhai]

ya i have conditional formatting that's why i want to empty the cell and set cell color to No fill color

Code should be like it should not delete formula applied in th range Because i am using it for further calculation like sum of SUP count of AL ....

 

[jackbhai]

Bro Your below Code is Giving error

Error

Run-time error '1004'


Method 'Range' of object'_Worksheet' failed


Code you given

Private Sub CommandCreate_new_Click()
Dim Ws As Worksheet
For Each Ws In Sheets(Array("Sheet1", "Sheet2", "Sheet3"))
Ws.Range("A4:J" & Rows.Count).Replace What:="SUP", Replacement:="", LookAt:=xlWhole
Ws.Range("A4:J" & Rows.Count).Replace What:="AP", Replacement:="", LookAt:=xlWhole
Ws.Range("A4:J" & Rows.Count).Replace What:="AL", Replacement:="", LookAt:=xlWhole
Next Ws
End Sub

 

[DanteAmor]

ya i have conditional formatting that's why i want to empty the cell and set cell color to No fill color

Code should be like it should not delete formula applied in th range Because i am using it for further calculation like sum of SUP count of AL ....

If you have conditional format, you have to fix the inside with conditional format, the macro can not change it, unless the macro erases your conditional format.
But better arrange your conditional format, so that when cell is empty you put the desired color.

 

[DanteAmor]

Bro Your below Code is Giving error

Error

Run-time error '1004'


Method 'Range' of object'_Worksheet' failed


Code you given

Private Sub CommandCreate_new_Click()
Dim Ws As Worksheet
For Each Ws In Sheets(Array("Sheet1", "Sheet2", "Sheet3"))
Ws.Range("A4:J" & Rows.Count).Replace What:="SUP", Replacement:="", LookAt:=xlWhole
Ws.Range("A4:J" & Rows.Count).Replace What:="AP", Replacement:="", LookAt:=xlWhole
Ws.Range("A4:J" & Rows.Count).Replace What:="AL", Replacement:="", LookAt:=xlWhole
Next Ws
End Sub

In which line?
Do you have combined cells?
protected sheet?
You could provide more detailed information about the conditions of your sheet.
The macro works well for me.

You could try a new book on 3 new sheets.
Only with data. Forget your book for a moment and try the macro again.


What version of excel do you have?