Paste Results to Spreadsheet

[kcince]

This is a follow up to a previous issue that I had on a different post. The code on the attached spreadsheet (which I gleaned from the web and adapted for my use) searches column A for ALL instances of a usder defined vale and returns the value in the cell that is in the same row of colum B.

I have it rigged to display all of the results ina msgbox. I cannot however figure out how to get the values pasted in column E starting at cell E2.

Any more help would be greatly appreciated.

kcince


Function FindAll(SearchRange As Range, FindWhat As Variant, _
Optional LookIn As XlFindLookIn = xlValues, Optional LookAt As XlLookAt = xlWhole, _
Optional SearchOrder As XlSearchOrder = xlByRows, _
Optional MatchCase As Boolean = False) As Range
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''
' FindAll
' This returns a Range object that contains all the cells in SearchRange in which FindWhat
' was found. The parameters to the function have the same meaning as they do for the
' Find method of the Range object. If no cells were found, the result of this function
' is Nothing.
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''
Dim FoundCell As Range
Dim FoundCells As Range
Dim LastCell As Range
Dim FirstAddr As String
With SearchRange
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
' In order to have Find search for the FindWhat value
' starting at the first cell in the SearchRange, we
' have to find the last cell in SearchRange and use
' that as the cell after which the Find will search.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
Set LastCell = .Cells(.Cells.Count)
End With
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Do the initial Find. If we don't find FindWhat in the first Find,
' we won't even go into the code which searches for subsequent
' occurrences.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Set FoundCell = SearchRange.Find(What:=FindWhat, After:=LastCell, _
LookIn:=LookIn, LookAt:=LookAt, SearchOrder:=SearchOrder, MatchCase:=MatchCase)
If Not FoundCell Is Nothing Then
''''''''''''''''''''''''''''''
' Set the FoundCells range
' to the first FoundCell.
''''''''''''''''''''''''''''''
Set FoundCells = FoundCell
''''''''''''''''''''''''''''
' FirstAddr will contain the
' address of the first found
' cell. We test each FoundCell
' to this address to prevent
' the Find from looping back
' through the range it has
' already searched.
''''''''''''''''''''''''''''
FirstAddr = FoundCell.Address
Do
''''''''''''''''''''''''''''''''
' Loop calling FindNext until
' FoundCell is nothing or
' we wrap around the first
' found cell (address is in
' FirstAddr).
'''''''''''''''''''''''''''''''
Set FoundCells = Application.Union(FoundCells, FoundCell)
Set FoundCell = SearchRange.FindNext(After:=FoundCell)
Loop Until (FoundCell Is Nothing) Or (FoundCell.Address = FirstAddr)
End If
''''''''''''''''''''
' Return the result.
''''''''''''''''''''
If FoundCells Is Nothing Then
Set FindAll = Nothing
Else
Set FindAll = FoundCells
End If
End Function
Sub TestFindAll()
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ''
' TestFindAll
' This is a test procedure for FindAll.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ''
Dim DstRng As Range
Dim myinput As String
Dim SearchRange As Range
Dim FoundCells As Range
Dim FoundCell As Range
Dim FindWhat As Variant
Dim MatchCase As Boolean
Dim LookIn As XlFindLookIn
Dim LookAt As XlLookAt
Dim SearchOrder As XlSearchOrder
myinput = InputBox("Enter Item Number")

''''''''''''''''''''''''''
' Set the variables to the
' appropriate values.
''''''''''''''''''''''''''
Set SearchRange = ThisWorkbook.Worksheets(1).Range("A1:A167")
FindWhat = "myinput"
LookIn = xlValues
LookAt = xlPart
SearchOrder = xlByColumns
MatchCase = False

'''''''''''''''''''
' Search the range.
'''''''''''''''''''
Set FoundCells = FindAll(SearchRange:=ThisWorkbook.Worksheets(1).Range("A1:A167"), FindWhat:=myinput)


''''''''''''''''''''''
' Display the results.
''''''''''''''''''''''
Dim s As String

If FoundCells Is Nothing Then
Debug.Print "No cells found."
Else
For Each FoundCell In FoundCells.Cells
s = s & vbCrLf & FoundCell.Offset(0, 1)
Next FoundCell
MsgBox s
End If
End Sub

[mdmackillop]

FoundCells.Offset(, 1).Copy Range("E2")

[mdmackillop]

More simply

Option Explicit
Sub DoFilter()
Dim rng As Range
Dim ToFilter As String
ToFilter = InputBox("String to find", , 6380512)
Set rng = Range(Cells(2, 1), Cells(Rows.Count, 1).End(xlUp))
Columns(1).AutoFilter field:=1, Criteria1:=ToFilter
Set rng = rng.SpecialCells(xlCellTypeVisible)
Columns(1).AutoFilter
rng.Offset(, 1).Copy Range("E2")
End Sub