Input Message

[Excel Help!]

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

 

[Jim Thomlinson]

This might be a bit different from what you were originally thinking but give
it a try...

Set ws = Application.InputBox("Select cell on target sheet.", Type:=8).Parent

 

[Norman Jones]

Hi Excel Help.

Dim two new variables:

Dim Res1 As String
Dim Res2 As String


and try replacing:

rng.AutoFilter Field:=4, Criteria1:="=XXXXX", Operator:=xlOr,
Criteria2:="=XXXXXXXXX"

with:

Res1 = Application.InputBox( _
Prompt:="Enter first criterion")
Res2 = Application.InputBox( _
Prompt:="Enter second criterion")


If Not Res1 = vbNullString _
And Res2 = vbNullString Then
rng.AutoFilter Field:=4, _
Criteria1:=Res1, _
Operator:=xlOr, _
Criteria2:=Res2
End If

 

[john]

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

 

[Excel Help!]

Thanks for the reply. But now I'm getting an error at this line
"WS.AutoFilter.Range.Copy".

 

[Norman Jones]

Hi Excel Help,

If Not Res1 = vbNullString _
And Res2 = vbNullString Then

Should have read:

If Not Res1 = vbNullString _
And Not Res2 = vbNullString Then

However, try the follwing version:

Res1 = Application.InputBox( _
Prompt:="Enter first criterion", _
Type:=3, _
Title:="Criterion 1")
Res2 = Application.InputBox( _
Prompt:="Enter second criterion", _
Type:=3, _
Title:="Criterion 3")


If Not Res1 = vbNullString _
And Not Res2 = vbNullString Then
rng.AutoFilter Field:=1, _
Criteria1:=Res1, _
Operator:=xlOr, _
Criteria2:=Res2
Else
WS.ShowAllData
End If

 

[Excel Help!]

The second input failed to pull the data; however, I entered your second
recommandation and it worked GREAT! Thanks for the help. Any idea or
recommanded sites I can visit for additonal training? Thanks again!

 

[Norman Jones]

Hi Excel Help,

=============
The second input failed to pull the data; however, I entered your second
recommandation and it worked GREAT! Thanks for the help. !
=============

Perhaps try something like:

Res1 = Application.InputBox( _
Prompt:="Enter first criterion", _
Type:=3, _
Title:="Criterion 1")
Res2 = Application.InputBox( _
Prompt:="Enter second criterion", _
Type:=31, _
Title:="Criterion 3")


If Not Res1 = vbNullString _
Or Not Res2 = vbNullString Then
rng.AutoFilter Field:=1, _
Criteria1:=Res1, _
Operator:=xlOr, _
Criteria2:=Res2
Else
MsgBox Prompt:="No criteria selected!", _
Buttons:=vbCritical, _
Title:="Warning"
Exit Sub
End If

If AutoFilterMode Then
WS.AutoFilter.Range.Copy
'Your code
End If


=============
Any idea or
recommanded sites I can visit for additonal training?
=============


Visit David McRitchie's tutorials page at:

http://www.mvps.org/dmcritchie/excel/excel.htm#tutorials


The VBA material is towards the end of that section