How to create a macro to generate report using advanced filter

[exploringmacro]

Hello,

Can somebody help me.

I'm creating a macro, wherein, I have a workbook with Sheet name "Finishes
Checklists" (see below data example), I need to run the report using Advanced
Filter, where all rows with "N" will only show on the report, but the report
must be on a new workbook then will prompt the user to save that workbook.

FINISHES Checklists Template

A B C D
(Column)
Location Item Completed Defects
Description
Y/N

Dining Ceiling N W5 - damage
Lobby Wall Y


FINISHES Report (after running Macro, on new workbook)

A B D (Column)
Location Item Defects Description

Dining Ceiling W5 - damage

Thank you.

 

[Bernie Deitrick]

exploringmacro,

I have assumed that your data table starts in cell A1 of sheet "Finishes Checklists" and is
contiguous (no completely blank rows or columns)

HTH,
Bernie
MS Excel MVP

Sub MacroForExploringMacro()
Dim myS As Worksheet
Dim myC As Worksheet
Dim myR As Range

Set myS = Worksheets("Finishes Checklists")

On Error Resume Next
Worksheets("Finishes Report").Delete

Set myC = Sheets.Add(Type:="Worksheet")
myC.Name = "Finishes Report"

Set myR = myS.Range("A1").CurrentRegion
myR.AutoFilter Field:=3, Criteria1:="N"
myR.SpecialCells(xlCellTypeVisible).Copy myC.Range("A1")
myS.ShowAllData
myC.Columns(3).Delete
myC.Move

ActiveWorkbook.SaveAs Application.GetSaveAsFilename _
("Finishes Report - items to be completed.xls")
End Sub

 

[exploringmacro]

Hi Bernie,

Thanks for your reply.

My data didnt start from A1. Below is the info.

A14 = COMMAND BUTTON
A518 = REPORT INFORMATION (PROJECT NAME, ADDRESS, BLK NO, INSP NO, ETC)
C19:C20 = CRITERIA RANGE (A19=COMPLETED, A20=Y/N)
A1919 = HEADER (LOCATION, ITEM, COMPLETED,DEFECTS)
C20 = Y/N
A21nxx = DATA FOR REPORTING

OBJECTIVE:
TO PREPARE THE INSPECTION REPORT BASED ON THE FINISHES CHECKLISTS WHERE IN
THE ANSWER IS "N" AND COPY ALL THE INFORMATION FROM FINISHES CHECKLISTS
WORKSHEET <A5nxx> TO NEW WORKBOOK WITH WORKSHEET NAME AS FINISHES REPORT
EXCEPT THE COLUMN C (DELETE COLUMN C), TO SHOW THE FINISHES REPORT THEN SAVE
THE FILE AS WHATEVER FILE NAME.


COLUMN A COLUMN B COLUMN C COLUMN D
R19 LOCATION ITEM COMPLETED DEFECTS DESCRIPTION
R20 Y / N
R21 FAMILY HALL FLOOR N F2- Consistent
colour tone ( Tonality )
R22 MASTER BATH WALL N W17 - Consistent
finished texture
R23 DINING CEILING Y

CAN ONLY PRINT THE ROWS AND COLUMNS WITH THE INFORMATION?

THANKS FOR YOUR HELP.

 

[exploringmacro]

Hello Mr. Bernie,

Below is the macro that I've created, can you please check what went wrong.
What happen is, it only open a new workbook which is correct, but nothing
inside. What I need is to copy all information from Finishes Checklists where
in the Column C = N, except Column C and except A14 (dont require in the
Finishes Report).

Sub GenFinReport()

Dim myS As Worksheet
Dim myC As Worksheet
Dim myR As Range

Set myS = Worksheets("Finishes Checklists")

On Error Resume Next
Worksheets("Finishes Report").Delete

Set myC = Sheets.Add(Type:="Worksheet")
myC.Name = "Finishes Report"

'criteria range'
Set myR = myS.Range("D19") = "Completed"
Set myR = myS.Range("D20") = "N"

myS.Range("A1:E194").AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=myS.Range("D1920"), _
CopyToRange:=myC.Range("A1:E194"), _
Unique:=False

myR.SpecialCells(xlCellTypeVisible).Copy myC.Range("A1:E194")
myS.ShowAllData
myC.Columns("D").Delete
myC.Move

ActiveWorkbook.SaveAs Application.GetSaveAsFilename _
("Finishes Report - items to be completed.xls")

End Sub

 

[exploringmacro]

Hello Mr. Bernie,

I've created the macro as per below.

What happen is, this macro only open and prompt to save the new workbook
which is correct, but on the workbook no information inside.

What I need is, to copy and filter the worksheet based on the criteria given
from Finishes Checklists then paste to new workbook and prompt to save the
file, but delete Finishes Checklists Column C (which is the criteria range)
and A14 (which is the cell for macro button).

Sub GenFinReport()

Dim myS As Worksheet
Dim myC As Worksheet
Dim myR As Range

Set myS = Worksheets("Finishes Checklists")

On Error Resume Next
Worksheets("Finishes Report").Delete

Set myC = Sheets.Add(Type:="Worksheet")
myC.Name = "Finishes Report"

'criteria range'
Set myR = myS.Range("D19") = "Completed"
Set myR = myS.Range("D20") = "N"

myS.Range("A1:E194").AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=myS.Range("D1920"), _
CopyToRange:=myC.Range("A1:E194"), _
Unique:=False

myR.SpecialCells(xlCellTypeVisible).Copy myC.Range("A1:E194")
myS.ShowAllData
myC.Columns("D").Delete
myC.Move

ActiveWorkbook.SaveAs Application.GetSaveAsFilename _
("Finishes Report - items to be completed.xls")

End Sub

 

[Bernie Deitrick]

Try this version.

HTH,
Bernie
MS Excel MVP

Sub MacroForExploringMacro2()
Dim myS As Worksheet
Dim myC As Worksheet
Dim myR As Range

Set myS = Worksheets("Finishes Checklists")

On Error Resume Next
Worksheets("Finishes Report").Delete

Set myC = Sheets.Add(Type:="Worksheet")
myC.Name = "Finishes Report"

Set myR = myS.Range("A19" & myS.Cells(Rows.Count, 4).End(xlUp))
myR.AutoFilter Field:=3, Criteria1:="N"
myS.Cells.SpecialCells(xlCellTypeVisible).Copy myC.Range("A1")
myS.ShowAllData
Intersect(myC.Range("19:" & Rows.Count), myC.Columns(3)).Delete Shift:=xlToLeft
myC.Move

ActiveWorkbook.SaveAs Application.GetSaveAsFilename _
("Finishes Report - items to be completed.xls")
End Sub

 

[exploringmacro]

Hello Mr. Bernie,

Thanks a lot, its working.

Only thing is, on the Finishes Report even the formula was copied over, as
this is the report editing is not allowed.

please help. thanks.

 

[Bernie Deitrick]

Change the one line

myS.Cells.SpecialCells(xlCellTypeVisible).Copy myC.Range("A1")

to three lines

myS.Cells.SpecialCells(xlCellTypeVisible).Copy
myC.Range("A1").PasteSpecial xlPasteValues
myC.Range("A1").PasteSpecial xlPasteFormats

HTH,
Bernie
MS Excel MVP

 

[exploringmacro]

Hello Mr. Bernie,

Thanks for your help.

Below is the macro that I'm using, this macros do the following
1. Open a new workbook with worksheet name as Finishes Report --- OK
2. Ask to save the file as Finishes Report and allow to change as any
filename --- OK
3. Copy the entire data from Finishes Checklists to Finishes Report --Not OK
(On the Finishes Report, need to copy or filter is only the answer with
"N" in column C, even though in this macro we specify the range, but seems
its not working)

Things that need your help and advise
1. Need to delete A1:C4, even though I already specify the command but seems
its not working
2. Need to specify the default size of each columns for printing purposes
3. Need to copy the company logo from Finishes Checklists to Finishes Report
4. Only answers in Column C as "N" will copy or filter into the Finishes
Report
5. The Finishes Report should only copy the filtered data from the Finishes
Checklists not the formula

Below is the macro that I'm using for testing.

Thanks for your help.

Dim myC As Worksheet
Dim myR As Range
Dim wb As Workbook

Set myS = Worksheets("Finishes Checklists")

On Error Resume Next
Worksheets("Finishes Report").Delete

Set myC = Sheets.Add(Type:="Worksheet")
myC.Name = "Finishes Report"

'criteria range' --- seems not working as it copies all data in the sheets
and didnt apply the filter

Set myR = myS.Range("C20") = "Completed"
Set myR = myS.Range("C21") = "N"

myS.Range("A5:E194").AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=myS.Range("C20:C21"), _
CopyToRange:=myC.Range("A1194"), _
Unique:=False

myS.Cells.SpecialCells(xlCellTypeVisible).Copy myC.Range("A1194")
myC.Range("A1").PasteSpecial xlPasteValues
myC.Range("A1").PasteSpecial xlPasteFormats

Application.DisplayAlerts = False
myC.Columns("C").Delete
Application.DisplayAlerts = True

myC.Move
myC("Sheet1").Range("A1:C4").Delete Shift:=xlShiftToLeft (this is to
delete the Range A1:C4, but seems not working)

ActiveWorkbook.SaveAs Application.GetSaveAsFilename _
("Finishes Report.xls")
End Sub

thanks for your help.

 

[Bernie Deitrick]

There is a world of difference between AutoFilters and Advanced filters. Since you have a very
simple criteria, stick with Autofilters.

Try this version.

HTH,
Bernie
MS Excel MVP

Sub TryNow()
Dim myC As Worksheet
Dim myS As Worksheet
Dim myR As Range
Dim wb As Workbook

Set myS = Worksheets("Finishes Checklists")

On Error Resume Next
Worksheets("Finishes Report").Delete

Set myC = Sheets.Add(Type:="Worksheet")
myC.Name = "Finishes Report"

Set myR = myS.Range("A5:E" & myS.Cells(Rows.Count, 5).End(xlUp))
myR.AutoFilter Field:=3, Criteria1:="N"
myS.Cells.SpecialCells(xlCellTypeVisible).Copy
myC.Range("A1").PasteSpecial xlPasteValues
myC.Range("A1").PasteSpecial xlPasteFormats
myC.Range("A1").PasteSpecial xlPasteColumnWidths
myS.ShowAllData

Intersect(myC.Range("5:" & Rows.Count), myC.Columns(3)).Delete Shift:=xlToLeft
myC.Range("A1:C4").Delete Shift:=xlShiftToLeft
myC.Move

ActiveWorkbook.SaveAs Application.GetSaveAsFilename _
("Finishes Report.xls")
End Sub

 

[exploringmacro]

Hello Mr. Bernie,

Thanks for your reply,

I use the command below, but still it didnt filter the rows with answer "N",
it copies all. Can I use Advanced Filter?

EXCEL INFO IS AS FOLLOWS

A14 ---> MACRO BUTTONG
A517 ---> HEADING (COMPANY NAME, ADDRESS, ETC)
A1920 --> FIELD NAME (A19 = LOCATION, B19 = ITEM, C19 = COMPLETED, C20 =
Y/N, D19 = DEFECTS DESCRIPTION)
A21194 --> INFORMATION

ON THE REPORT, ONLY ROWS FROM A21194 WHERE COLUMN C:21:C194 =N WILL SHOW
ON THE REPORT.

Also, the Margins size and delete rows not working. below is the command.

please help to check, thanks so much.

Sub GENREP()

Dim myC As Worksheet
Dim myS As Worksheet
Dim myR As Range
Dim wb As Workbook

Set myS = Worksheets("Finishes Checklists")

On Error Resume Next
Worksheets("Finishes Report").Delete

Set myC = Sheets.Add(Type:="Worksheet")
myC.Name = "Finishes Report"

Set myR = myS.Range("A5:E" & myS.Cells(Rows.Count, 5).End(xlUp))
myR.AutoFilter Field:=3, Criteria1:="N" -----> NOT WORKING
myS.Cells.SpecialCells(xlCellTypeVisible).Copy
myC.Range("A1").PasteSpecial xlPasteValues
myC.Range("A1").PasteSpecial xlPasteFormats
myC.Range("A1").PasteSpecial xlPasteColumnWidths
myS.ShowAllData

Intersect(myC.Range("5:" & Rows.Count), myC.Columns(3)).Delete Shift:=xlToLeft
myC.Range("A1:C4").Delete Shift:=xlShiftToLeft -------> NOT WORKING
myC.Move

Columns("A:A").ColumnWidth = 32
Columns("B:B").ColumnWidth = 26
Columns("C:C").ColumnWidth = 98

With myC.PageSetup -------> NOT WORKING
.LeftMargin = Application.InchesToPoints(0.1)
.RightMargin = Application.InchesToPoints(0.1)
.TopMargin = Application.InchesToPoints(0.1)
.BottomMargin = Application.InchesToPoints(0.1)
.HeaderMargin = Application.InchesToPoints(0.1)
.FooterMargin = Application.InchesToPoints(0.1)
End With

ActiveWorkbook.SaveAs Application.GetSaveAsFilename _
("Finishes Report.xls")
End Sub

 

[Bernie Deitrick]

Try this version.

HTH,
Bernie
MS Excel MVP


Sub GENREP()

Dim myC As Worksheet
Dim myS As Worksheet
Dim myR As Range
Dim wb As Workbook
Dim myRow As Long

Set myS = Worksheets("Finishes Checklists")

Application.DisplayAlerts = False
On Error Resume Next
Worksheets("Finishes Report").Delete
Application.DisplayAlerts = True

Set myC = Sheets.Add(Type:="Worksheet")
myC.Name = "Finishes Report"

myS.Activate
myRow = myS.Cells(Rows.Count, 3).End(xlUp).Row
Set myR = myS.Range("A20:E" & myRow)
myR.AutoFilter Field:=3, Criteria1:="N"
myS.Cells.SpecialCells(xlCellTypeVisible).Copy
myC.Range("A1").PasteSpecial xlPasteValues
myC.Range("A1").PasteSpecial xlPasteFormats
myR.AutoFilter

Intersect(myC.Range("19:" & Rows.Count), myC.Columns(3)).Delete Shift:=xlToLeft
myC.Range("A1:C4").Delete Shift:=xlShiftToLeft
myC.Move

Columns("A:A").ColumnWidth = 32
Columns("B:B").ColumnWidth = 26
Columns("C:C").ColumnWidth = 98

With myC.PageSetup
.LeftMargin = Application.InchesToPoints(0.1)
.RightMargin = Application.InchesToPoints(0.1)
.TopMargin = Application.InchesToPoints(0.1)
.BottomMargin = Application.InchesToPoints(0.1)
.HeaderMargin = Application.InchesToPoints(0.1)
.FooterMargin = Application.InchesToPoints(0.1)
End With

ActiveWorkbook.SaveAs Application.GetSaveAsFilename _
("Finishes Report.xls")
End Sub

 

[exploringmacro]

Hello Mr. Bernie,

Thanks for your help.

I just open this discussion, and try your command and its working.

Thanks so much.

I just want to ask one more question,on the new created Finishes Report
(B7), the words in there is Finishes Checklists, is there a way to change to
Finishes Report?

Thanks for your help.

 

[Patrick Molloy]

I suspect that the value in B7 is copied from the #Finishes Checklists#
worksheet, so you'll need to add this line

MyC.Range("B7")="Finishes Report"

before the 'saveAs' line, or wherever most appropriate