Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Autofilter with criteria from userform
Good afternoon,
I've been using Ron de Bruin's code below to perform an auto filter on one worksheet and copy/paste the results into another sheet. The auto filter, when run, will display a message box in which the user will input the auto filter criteria. This works perfectly, however, I need to make one small change...I need to provide a combo box with preset (they will not change) options to choose from, rather than a blank space to type in the filter criteria. My current code is below. Option Explicit Sub CreateMarketingElectionReport() '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 Dim endrange As Long End With Call CopyMarketingElectionReport End Sub I have created a Userform "frmChooseElection" which provides the drop down for the user to select their criteria. However, I'm not sure how to tie in my userform into the code above. Any help is tremendously appreciated, I've been working on this for over a week without figuring it out yet. |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Autofilter with criteria from userform
Hi
Without using a form, but using a row above the header (filter) row, take a look at some code I wrote called Fast Filter and see is that helps you any. You can find it on Debra Dalgleish's site http://www.contextures.com/excelfilesRoger.html I have a slightly updated version of it, which has not yet been posted to the site, which you are welcome to if you mail me direct. -- Regards Roger Govier "stac2410" wrote in message ... Good afternoon, I've been using Ron de Bruin's code below to perform an auto filter on one worksheet and copy/paste the results into another sheet. The auto filter, when run, will display a message box in which the user will input the auto filter criteria. This works perfectly, however, I need to make one small change...I need to provide a combo box with preset (they will not change) options to choose from, rather than a blank space to type in the filter criteria. My current code is below. Option Explicit Sub CreateMarketingElectionReport() '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 Dim endrange As Long End With Call CopyMarketingElectionReport End Sub I have created a Userform "frmChooseElection" which provides the drop down for the user to select their criteria. However, I'm not sure how to tie in my userform into the code above. Any help is tremendously appreciated, I've been working on this for over a week without figuring it out yet. __________ Information from ESET Smart Security, version of virus signature database 5316 (20100727) __________ The message was checked by ESET Smart Security. http://www.eset.com __________ Information from ESET Smart Security, version of virus signature database 5316 (20100727) __________ The message was checked by ESET Smart Security. http://www.eset.com |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Autofilter with criteria from userform
Roger Govier wrote on 07/27/2010 07:36 ET :
Hi Without using a form, but using a row above the header (filter) row, take a look at some code I wrote called Fast Filter and see is that helps you any. You can find it on Debra Dalgleish's site http://www.contextures.com/excelfilesRoger.html I have a slightly updated version of it, which has not yet been posted to the site, which you are welcome to if you mail me direct. Regards Roger Govier "stac2410" wrote in message news: Good afternoon, I've been using Ron de Bruin's code below to perform an auto filter on one worksheet and copy/paste the results into another sheet. The auto filter, when run, will display a message box in which the user will input the auto filter criteria. This works perfectly, however, I need to make one small change...I need to provide a combo box with preset (they will not change) options to choose from, rather than a blank space to type in the filter criteria. My current code is below. Option Explicit Sub CreateMarketingElectionReport() '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&quot ; & 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:", 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 Dim endrange As Long End With Call CopyMarketingElectionReport End Sub I have created a Userform "frmChooseElection" which provides the drop down for the user to select their criteria. However, I'm not sure how to tie in my userform into the code above. Any help is tremendously appreciated, I've been working on this for over a week without figuring it out yet. __________ Information from ESET Smart Security, version of virus signature database 5316 (20100727) __________ The message was checked by ESET Smart Security. http://www.eset.com __________ Information from ESET Smart Security, version of virus signature database 5316 (20100727) __________ The message was checked by ESET Smart Security. http://www.eset.com I downloaded your sheet and took a look at it. It's definitely neat and something I'm going to hang onto to use, however it doesn't help me much with what I need to do for this particular situation. What I have is a sheet that's titled "Reports" that has buttons tied to macros that will perform autofilters on other sheets, and copy/paste that data into a separate workbook for the users. I am the only person who actually uses the data sheets. Since your code would require the users to use the data sheets instead of the Reports page with the buttons, I'm not sure it's the solution I'm looking for. I just need to figure out how to change Scenario A (below) to Scenario B (below Scenario A): SCENARIO A (what's currently happening): The user clicks a button and a message box pops up where they type in criteria, then click "OK" and the auto filter is performed, then the data is copied and pasted into a new workbook. (See code previously posted to see how it's currently doing this.) SCENARIO B (what I need to happen): The user clicks a button and a message box pops up where they select the criteria via a dropdown box, then click "OK" and the auto filter is performed, then the data is copied and pasted into a new workbook. The reason I need the dropdown box is because there are only a set number of options they can choose from (6 to be exact), and the options are similar in wording and spelling, so it's imperative that they spell it exactly as it appears in the list, otherwise the filter results could be skewed. Any suggestions? |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Help with Userform/Autofilter/VBA | Excel Programming | |||
Userform results as Autofilter Criteria | Excel Programming | |||
Selection.AutoFilter Field / Criteria = criteria sometimes non-existing on worksheet | Excel Programming | |||
Autofilter in a userform | Excel Programming | |||
AutoFilter & UserForm | Excel Programming |