msg box to apply filter

[Kirsty]

Hi,

I want a macro that has a message box to ask for input and then filters the
data based on hte input. How would I go about this?

 

[ryguy7272]

With your data on Sheet1, run this code:
Sub CopyCA()

Dim DestSheet As Worksheet
Set DestSheet = Worksheets("Sheet2")

Dim sRow As Long
Dim dRow As Long
Dim sCount As Long
sCount = 0
dRow = 0

myword = InputBox("Enter items to search for.")

For sRow = 1 To Range("A65536").End(xlUp).Row

If Cells(sRow, "A") Like "*" & myword & "*" Then
sCount = sCount + 1
dRow = dRow + 1
Cells(sRow, "A").Copy Destination:=DestSheet.Cells(dRow, "A")
End If
Next sRow

MsgBox sCount & " Significant rows copied", vbInformation, "Transfer Done"

End Sub


The results are copied/pasted to Sheet2.

HTH,
Ryan---

 

[Kirsty]

I am getting an error on the line
If Cells(sRow, "A") Like "*" & myword & "*" Then, any suggestions?

Sub CopyCA()

Dim DestSheet As Worksheet
Set DestSheet = Worksheets("Sheet2")

Dim sRow As Long
Dim dRow As Long
Dim sCount As Long
sCount = 0
dRow = 0

myword = InputBox("Enter required week.")

For sRow = 1 To Range("A65536").End(xlUp).Row

If Cells(sRow, "A") Like "*" & myword & "*" Then
sCount = sCount + 1
dRow = dRow + 1
Cells(sRow, "A").Copy Destination:=DestSheet.Cells(dRow, "A")
End If
Next sRow

MsgBox sCount & " Significant rows copied", vbInformation, "Transfer Done"

End Sub

 

[Mike Fogleman]

Sub Filter()
Dim rng As Range
Dim MyCrit As String

MyCrit = InputBox("Enter Filter Criteria")
Set rng = Range("E1:F8")
rng.AutoFilter Field:=1, Criteria1:=MyCrit
End Sub

Mike F