Friday, 6 September 2013

How to get out of a code if there is no information filtered to copy instead of it copying everything?

How to get out of a code if there is no information filtered to copy
instead of it copying everything?

Ok, it was kind of hard to explain this question but I have an Excel
spreadsheet that filters a database I created in Excel for certain values
and copies them into their respective sections. I have about 10 different
sections and the last two are Adders & Take-Outs which for certain system
sizes do not have any items in the database so if I tell it to filter for
Adders then it filters and there are no line items in the database so it
copies over every item in the database (I don't know why). Below is the
code I have for the Adders section.
'To add Adders
Range("B12").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
Selection.Font.Bold = True
Selection.Font.Underline = xlUnderlineStyleSingle
ActiveCell.FormulaR1C1 = "ADDERS"
ActiveCell.Offset(1, 15).Select
ActiveCell.FormulaR1C1 = "ADDERS"
ActiveCell.Offset(-1, -15).Select
'To filter data
Sheets("Database").Select
ActiveSheet.ListObjects("Database").Range.AutoFilter Field:=5,
Criteria1:="4600", Operator:=xlOr, Criteria2:="All"
ActiveSheet.ListObjects("Database").Range.AutoFilter Field:=6,
Criteria1:="Adder"
ActiveSheet.ListObjects("Database").Range.AutoFilter Field:=7,
Criteria1:=Array("6201", "6201 Elec", "6201 Eng", "6201 FS Rad", "6201 FS
SW", "6201 Rad", "6201 SII", "6201 Train", "CH Elec", "CH Eng", "CH FS",
"CH High", "CH SII", "CH Std", "CH SW", "CM", "CM Eng", "Coiler", "Elec",
"Elec Eng", "Eng", "ES", "Fluids Eng", "FM", "FS Elec", "FS SII", "FS SW",
"Launder", "MA", "MA FS", "MA SII", "MA Train", "ML", "PMDA", "PP High",
"PP Low", "QS", "Selee", "Selee Eng", "SII", "STAS", "STAS FS", "Train"),
Operator:=xlFilterValues
'To select correct data to copy
Application.Run ("SelectDataToCopy")
'To copy data
Sheets("Quote Sheet").Select
ActiveCell.Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues
Application.Run ("Borders")
Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(0, 14)).Select
Application.Run ("Borders")
'To insert formulas
Range("B12").Select
Cells.Find(What:="ADDERS", After:=ActiveCell, LookIn:=xlValues,
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:=True, SearchFormat:=False).Activate
ActiveCell.Offset(1, 1).Select
Application.Run ("Formulas")
ActiveCell.Offset(0, 2).Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(""ADDERS"",C[-16]:C,17,FALSE)"
Application.Run ("AutofillOptions")
See the problem is mainly with the Autofilter section. It filters for all
of these criteria but there are no items in the database so it copies
everything. Is there a code or any way to alter this code to tell it to
step out of this if there are no items filtered. I still want it to create
the adders section because I have a button to add custom items I just need
it not to copy all the items if there are none filtered. Any help is
greatly appreciated, thanks.

No comments:

Post a Comment