Input Message
Not complete but as a guide, something like the following may work for you.
You can adapt as required. If you are going to ask users to input the sheet
name then some error checking would be advisable. I have added a readily
published sheetexists function which you may find useful.
Sub Copy_With_AutoFilter1()
Dim WS As Worksheet
Dim WSNew As Worksheet
Dim rng As Range
Dim rng2 As Range
Dim shname As Variant
With Application
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
End With
Top:
shname = Application.InputBox(prompt:="Enter Sheet Name", Title:="Enter
Sheet Name", Type:=2)
If VarType(shname) = vbBoolean Then
If shname = False Then
Debug.Print "cancelled"
msg = MsgBox("Do You Want To Cancel?", 36, "Cancel")
If msg = 6 Then
Exit Sub
Else
GoTo Top
End If
End If
End If
On Error Resume Next
If Worksheets(shname) Is Nothing Then
If SheetExists((shname)) = True Then
Set WS = Sheets(shname) '<<< Change
Set rng = WS.Range("A1:J" & Rows.Count)
WS.AutoFilterMode = False
Sheets("XXXX").Delete
On Error GoTo 0
rng.AutoFilter Field:=4, Criteria1:="=XXXXX", Operator:=xlOr, _
Criteria2:="=XXXXXXXXX"
Set WSNew = Worksheets.Add
WSNew.Name = shname
WS.AutoFilter.Range.Copy
With WSNew.Range("A1")
' Paste:=8 will copy the columnwidth in Excel 2000 and higher
.PasteSpecial Paste:=8
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
Application.CutCopyMode = False
.Select
End With
WS.AutoFilterMode = False
Else
msg = MsgBox("Sheet " & shname & " Does Not Exist", 16, "Warning")
GoTo Top
End If
End If
With Application
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = False
End With
End Sub
Function SheetExists(SName As String, _
Optional ByVal WB As Workbook) As Boolean
On Error Resume Next
If WB Is Nothing Then Set WB = ThisWorkbook
SheetExists = CBool(Len(WB.Sheets(SName).Name))
End Function
--
jb
"Excel Help!" wrote:
I'd like to know how to write in an input-message box so that users can input
the search requirement "Criteria" . The code below, I have to include the
Criteria into the code. However, I'd like for the user to input (prompt)
without accessing the code? Thanks for any help in advance.
Sub Copy_With_AutoFilter1()
Dim WS As Worksheet
Dim WSNew As Worksheet
Dim rng As Range
Dim rng2 As Range
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set WS = Sheets("XX") '<<< Change
Set rng = WS.Range("A1:J" & Rows.Count)
WS.AutoFilterMode = False
On Error Resume Next
Application.DisplayAlerts = False
Sheets("XXXX").Delete
Application.DisplayAlerts = True
On Error GoTo 0
rng.AutoFilter Field:=4, Criteria1:="=XXXXX", Operator:=xlOr,
Criteria2:="=XXXXXXXXX"
Set WSNew = Worksheets.Add
WSNew.Name = "XX"
WS.AutoFilter.Range.Copy
With WSNew.Range("A1")
' Paste:=8 will copy the columnwidth in Excel 2000 and higher
.PasteSpecial Paste:=8
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
Application.CutCopyMode = False
.Select
End With
WS.AutoFilterMode = False
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
|