Thread: Input Message
View Single Post
  #8   Report Post  
Posted to microsoft.public.excel.programming
John John is offline
external usenet poster
 
Posts: 2,069
Default 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