G
Guest
Guest
I am using the Marco below, pieced together from previous code from this board, to move selected data to a new sheet. It works like I need except that if a user puts the column letter instead of the column number for the Auto Filter field, flagged in bold in the Marco, I get and error. How can this error be handled? I used on error Resume Next and it takes care of the error but instead of filtered data all data is put in the new sheet, thought there might be a better way, Thanks for your help
Option Explicit
Dim FilterCriteria
Dim CurrentsheetName As String
Dim NewFileName As String
Dim ws As Worksheet
Dim Flag As Boolean
Dim C
Public Sub Filter_Data()
Flag = False
Application.ScreenUpdating = False
Application.DisplayAlerts = False
CurrentsheetName = ActiveSheet.Name
FilterCriteria = UCase(InputBox("Enter Your Filter Criteria"))
'CHANGE THIS RANGE WHEN UPDATING THE RANGE
'THERE ARE two PLACES THAT NEED TO BE CHANGED!
For Each C In Range("a1:f752") '#1
If UCase(C.Value) = FilterCriteria Then Flag = True: Exit For
Next C
If Not Flag Or FilterCriteria = "" Then MsgBox "No Match To Your Criteria ": Exit Sub
'CHANGE THIS RANGE WHEN UPDATING THE RANGE
'THERE ARE two PLACES THAT NEED TO BE CHANGED!
Range("A1:f752").Select '#2
Selection.AutoFilter
'The error happens below if someone puts the column letter and not the number
Selection.AutoFilter field:=(InputBox("Enter Column NUMBER, A=1, B=2, C=3, D=4, E=5, F=6... THIS MUST BE A NUMBER AND NOT A LETTER")), Criteria1:=FilterCriteria
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
With Worksheets.Add
.Range("A1").PasteSpecial Paste:=xlPasteAll
.Move after:=Worksheets(Worksheets.Count)
For Each ws In Worksheets
If ws.Name = FilterCriteria Then ws.Delete
Next ws
.Name = FilterCriteria
End With
Cells.Select
Selection.Columns.AutoFit
Range("A1").Select
Worksheets(CurrentsheetName).Activate
Selection.AutoFilter field:=1
Selection.AutoFilter
Range("B65536").Select
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Select
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Option Explicit
Dim FilterCriteria
Dim CurrentsheetName As String
Dim NewFileName As String
Dim ws As Worksheet
Dim Flag As Boolean
Dim C
Public Sub Filter_Data()
Flag = False
Application.ScreenUpdating = False
Application.DisplayAlerts = False
CurrentsheetName = ActiveSheet.Name
FilterCriteria = UCase(InputBox("Enter Your Filter Criteria"))
'CHANGE THIS RANGE WHEN UPDATING THE RANGE
'THERE ARE two PLACES THAT NEED TO BE CHANGED!
For Each C In Range("a1:f752") '#1
If UCase(C.Value) = FilterCriteria Then Flag = True: Exit For
Next C
If Not Flag Or FilterCriteria = "" Then MsgBox "No Match To Your Criteria ": Exit Sub
'CHANGE THIS RANGE WHEN UPDATING THE RANGE
'THERE ARE two PLACES THAT NEED TO BE CHANGED!
Range("A1:f752").Select '#2
Selection.AutoFilter
'The error happens below if someone puts the column letter and not the number
Selection.AutoFilter field:=(InputBox("Enter Column NUMBER, A=1, B=2, C=3, D=4, E=5, F=6... THIS MUST BE A NUMBER AND NOT A LETTER")), Criteria1:=FilterCriteria
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
With Worksheets.Add
.Range("A1").PasteSpecial Paste:=xlPasteAll
.Move after:=Worksheets(Worksheets.Count)
For Each ws In Worksheets
If ws.Name = FilterCriteria Then ws.Delete
Next ws
.Name = FilterCriteria
End With
Cells.Select
Selection.Columns.AutoFit
Range("A1").Select
Worksheets(CurrentsheetName).Activate
Selection.AutoFilter field:=1
Selection.AutoFilter
Range("B65536").Select
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Select
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub