Home |
Search |
Today's Posts |
#1
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
Good morning! I've been using Ron de Bruin's code to create the following
procedu Push a button to run a report. When the button is pushed, a message box appears and asks for criteria. The user types in the criteria and says "OK", then an autofilter is performed on a main worksheet in the workbook, using the input criteria as the autofilter criteria. The results are then pasted over into a specified worksheet in the workbook. The code below does this perfectly: 'Note: This macro use the function LastRow 'Important: The DestSh must exist Dim My_Range As Range Dim DestSh As Worksheet Dim CalcMode As Long Dim ViewMode As Long Dim FilterCriteria As String Dim CCount As Long Dim rng As Range 'Set filter range Set My_Range = Worksheets("Marketing Elections").Range("A4:Z" & LastRow(Worksheets("Marketing Elections"))) 'Set the destination worksheet Set DestSh = Sheets("Marketing Election Report") If ActiveWorkbook.ProtectStructure = True Or My_Range.Parent.ProtectContents = True Then MsgBox "Sorry, that feature is not available when the workbook is protected.", vbOKOnly, "Copy to new worksheet" Exit Sub End If 'Change ScreenUpdating, Calculation, EnableEvents, .... With Application CalcMode = .Calculation .Calculation = xlCalculationManual .ScreenUpdating = False .EnableEvents = False End With ViewMode = ActiveWindow.View ActiveWindow.View = xlNormalView ActiveSheet.DisplayPageBreaks = False 'Firstly, remove the AutoFilter My_Range.Parent.AutoFilterMode = False 'If you want to filter on a Inputbox value use this FilterCriteria = InputBox("What type of election do you need info for?", _ "Enter election type") If FilterCriteria = "" Then Exit Sub FilterCriteria = Replace(FilterCriteria, "*", "") FilterCriteria = "*" & FilterCriteria & "*" My_Range.AutoFilter Field:=22, Criteria1:="=" & FilterCriteria 'Check if there are not more then 8192 areas(limit of areas that Excel can copy) CCount = 0 On Error Resume Next CCount = My_Range.Columns(1).SpecialCells(xlCellTypeVisible ).Areas(1).Cells.Count On Error GoTo 0 If CCount = 0 Then MsgBox "There are more than 8192 areas:" _ & vbNewLine & "It is not possible to copy the visible data." _ & vbNewLine & "Tip: Sort your data before you use this macro.", _ vbOKOnly, "Copy to worksheet" Else 'Copy the visible data and use PasteSpecial to paste to the Destsh With My_Range.Parent.AutoFilter.Range On Error Resume Next ' Set rng to the visible cells in My_Range without the header row Set rng = .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count) _ .SpecialCells(xlCellTypeVisible) On Error GoTo 0 If Not rng Is Nothing Then 'Copy and paste the cells into DestSh below the existing data rng.Copy With DestSh.Range("A" & LastRow(DestSh) + 1) ' Paste:=8 will copy the columnwidth in Excel 2000 and higher ' Remove this line if you use Excel 97 '.PasteSpecial Paste:=8 .PasteSpecial xlPasteValues .PasteSpecial xlPasteFormats Application.CutCopyMode = False End With 'Delete the rows in the My_Range.Parent worksheet 'rng.EntireRow.Delete End If End With End If 'Close AutoFilter 'My_Range.Parent.AutoFilterMode = False My_Range.Parent.ShowAllData 'Restore ScreenUpdating, Calculation, EnableEvents, .... With Application .EnableEvents = True .Calculation = CalcMode End With Call CopyMarketingElectionReport End Sub What I need to do though, is modify this so that instead of the user typing in their criteria in the given field, they are given a combobox with set data criteria (the list is not dynamic), and their selection performs the autofilter just the same as above. Any suggestions? |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
autofilter master copy data to worksheet | Excel Programming | |||
Autofilter & copy results programmatically | Excel Programming | |||
Copying, Pasting Autofilter results to a region more specific than a specified worksheet. | Excel Programming | |||
Automate Autofilter Results - Copy to New Sheet | Excel Programming | |||
Copy Autofilter results macro | Excel Programming |