Delete Sheets according to cell value

[aequitas1903]

Hi everyone,

I am working on a project and I was a little confused how to do it with vba and lack of knowledge. Hope you guys can help me.

I will try to explain the situation, I got an excel which has nearly 800 sheets and in sheet named "Summary" where B column has numbers from 100 to 799 (All this numbers have specific sheet for themselves. Sheet names are like 100,101,102 ,....,799) and column E has a summary of absolutes of column C + column D. I wish to delete the sheets which F column value is zero (meaningless numbers). I can show you a little example what I mean.

[TABLE="class: grid, width: 500, align: left"]
<TBODY>[TR]
[TD][/TD]
[TD]B
[/TD]
[TD]C
[/TD]
[TD]D
[/TD]
[TD]E
[/TD]
[/TR]
[TR]
[TD]1
[/TD]
[TD]100
[/TD]
[TD]12
[/TD]
[TD]13
[/TD]
[TD]=abs(c1)+abs(c2) =25
[/TD]
[/TR]
[TR]
[TD]2
[/TD]
[TD]101
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]3
[/TD]
[TD]102
[/TD]
[TD]9
[/TD]
[TD]-9
[/TD]
[TD]18
[/TD]
[/TR]
[TR]
[TD]4
[/TD]
[TD]103
[/TD]
[TD]3
[/TD]
[TD][/TD]
[TD]3
[/TD]
[/TR]
</TBODY>[/TABLE]









As mentioned before I got 800 values in E column. I can filter and see which numbers are zero. In the table above sheet named 101 should be deleted.

I thought to use a formula (=vlookup(101,'summary'!A:E,5.FALSE) in A1 cell in every sheet to see if the value of the number is zero and delete that sheet. For example the macro will check A1 column in everysheet and if the value is zero it will delete the sheet entirely. Or It can filter zero valued numbers in column E in "Summary" sheet and delete sheets from there.

Is it possible to do something like this ? I appreciate your thoughts and knowledge and it will save my hours if it is possible. I have to change number values periodicly and have to analyze them all everytime.

Any help is appreciated. Any ideas can give me a new perspective.

Thanks for your help.
Kind Regards

 

[Smitty]

Maybe something like this:

<font face=Calibri><SPAN style="color:#00007F">Sub</SPAN> DeleteSheets()<br>    <SPAN style="color:#00007F">Dim</SPAN> ws <SPAN style="color:#00007F">As</SPAN> Worksheet<br>    <SPAN style="color:#00007F">Dim</SPAN> c <SPAN style="color:#00007F">As</SPAN> Range<br>    <SPAN style="color:#00007F">Dim</SPAN> lr <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN><br>    <br>    <SPAN style="color:#00007F">Set</SPAN> ws = Sheets("Summary")<br>        lr = ws.Cells(Rows.Count, "F").End(xlUp).Row<br>        ws.Range("$A$1:$F$" & lr).AutoFilter Field:=6, Criteria1:=0<br>        <br>            <SPAN style="color:#00007F">For</SPAN> <SPAN style="color:#00007F">Each</SPAN> c <SPAN style="color:#00007F">In</SPAN> ws.Range("F2:F" & lr).SpecialCells(xlCellTypeVisible)<br>                Application.DisplayAlerts = <SPAN style="color:#00007F">False</SPAN><br>                    Sheets(Trim(ws.Cells(c.Row, "A").Value)).Delete<br>                Application.DisplayAlerts = <SPAN style="color:#00007F">True</SPAN><br>            <SPAN style="color:#00007F">Next</SPAN> c<br>            <br>        ws.Range("$A$1:$F$" & lr).AutoFilter<br>    <br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN></FONT>

HTH,

 

[aequitas1903]

Hi,

Thanks for your help Smitty. But there seems to be a little diffculty. I tried to change your recommendation to make it work with my excel. I recolored the values I changed. And I got an error message in blue colored row.

Sub DeleteSheets()
Dim ws As Worksheet
Dim c As Range
Dim lr As Long

Set ws = Sheets("Summary")
lr = ws.Cells(Rows.Count, "H").End(xlUp).Row
ws.Range("$B$8:$H$" & lr).AutoFilter Field:=7, Criteria1:= "-"

For Each c In ws.Range("H8:H" & lr).SpecialCells(xlCellTypeVisible)
Application.DisplayAlerts = False
Sheets(Trim(ws.Cells(c.Row, "A").Value)).Delete
Application.DisplayAlerts = True
Next c

ws.Range("$B$1:$H$" & lr).AutoFilter

End Sub

I dunno if it is allowed to share screenshot but here is my table.

I wont change the cell placement again Please note that I changed the format of the cell and the criteria is " - " in column H. In this screen sheets numbered 103,104,106,108 will be deleted.

Thank you very much for your attention and reply. Sorry for my late reply. I will be happy to hear from you again. I am still open to new ideas.

Thanks a lot.

 

[Smitty]

You need to change "A" to "B":

Sheets(Trim(ws.Cells(c.Row, "A").Value)).Delete

Since that's where your sheet names are.

 

[aequitas1903]

Thank you so much for your quick reply Smitty. It works perfectly Now I have to try to figure out something else. Maybe I will disturb you with my stupid questions again Thank you so much again. Mrexcel is the most helpful site

Best Regards

 

[aequitas1903]

Hello again,

I changed the code a little bit. Here is the final form.

Sub DeleteSheets()
    Dim ws As Worksheet
    Dim c As Range
    Dim lr As Long
    Set ws = Sheets("Lead")
    lr = ws.Cells(Rows.Count, "C").End(xlUp).Row
    ws.Range("$B$8:$I$" & lr).AutoFilter Field:=1, Criteria1:="2"
    ws.Range("$B$8:$I$" & lr).AutoFilter Field:=8, Criteria1:="-"
    For Each c In ws.Range("C9:C" & lr).SpecialCells(xlCellTypeVisible)
    Application.DisplayAlerts = False
    Sheets(Trim(ws.Cells(c.Row, "C").Value)).Delete
    Application.DisplayAlerts = True
    Next c
    ws.Range("$B$8:$H$" & lr).AutoFilter Field:=8
    ws.Range("$B$8:$H$" & lr).AutoFilter Field:=1
    ws.Range("A9").Select
End Sub

It works fine but at the end I get a run-time error '9':
Subscript out of range

Is there a way to disable this error or keep it in a range because I have another code works after this code. But when it gives the error, script stops and it won't continue. My search range is between C9:C778


Thank you in advance.

 

[Smitty]

What line does the code bomb on?

 

[aequitas1903]

Hi Smitty,

Sorry for late reply. Actually it does its work but after it is finished there comes the error

 

[Smitty]

So is it bombing on the Select line? If so just delete that line.

 

[aequitas1903]

Actually it bombs at this line .

Sheets(Trim(ws.Cells(c.Row, "C").Value)).Delete

And can not execute following codes

ws.Range("$B$8:$H$" & lr).AutoFilter Field:=8
ws.Range("$B$8:$H$" & lr).AutoFilter Field:=1
Range("A9").Select