I want to write a macro that searches for the contents of a cell and not what was initially in the cell

[bat18]

To make myself slightly clearer.

I need to write a macro that will find the contents of a cell.

For example in cell B3 is the word straw, I need to copy cell B3 and paste it into the find function and find all words with straw in.

Now this works fine, but when I change the word in B3 to lemon it still searches for straw.

Does anyone know how I can fix the macro to search the contents of cell B3 and not just the word straw

Thanks

 

[doofusboy]

If you post your macro code it will be easier to show you what needs to be fixed.

 

[bat18]

Range("B3").Select
Selection.Copy
Sheets("Chilled").Select
Cells.Find(What:="straw", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
Application.CutCopyMode = False
Selection.Copy
Sheets("Search").Select
Range("B6").Select
ActiveSheet.Paste
End Sub

So instead of searching for the contents in cell B3 it always searches for straw.

Thanks

 

[doofusboy]

Try modifying to something like this:

Range("B3").Select
Selection.Copy
Sheets("Chilled").Select
Cells.Find(What:=[COLOR=red][B]Range("B3").Value[/B][/COLOR], After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
Application.CutCopyMode = False
Selection.Copy
Sheets("Search").Select
Range("B6").Select
ActiveSheet.Paste
End Sub

 

[bat18]

Of course, brilliant!!

The second part to my problem is that I want to be able to copy all the cells which contain straw not just the first one excel finds.

Is there a find all button in VBA in order to achieve this?

 

[jbeaucaire]

This gets a little more complex to run the search over and over in a loop. This is designed to take the text in cell B3 of sheet Search and find the cells in sheet Chilled and copy them into column B of the sheet Search.

Option Explicit

Sub FindCopyAll()
Dim rFind   As Range
Dim rFirst  As Range
Dim rText   As String

rText = Sheets("Search").Range("B3").Value
On Error Resume Next

With Sheets("Chilled")
    Set rFind = .Cells.Find(rText, After:=.[A1], LookIn:=xlFormulas, LookAt:=xlPart, _
        SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, _
        SearchFormat:=False)
    
    If Not rFind Is Nothing Then
        Set rFirst = rFind
        
        Do
            rFind.Copy Sheets("Search").Range("B" & Rows.Count).End(xlUp).Offset(1)
            Set rFind = .Cells.FindNext(rFind)
        Loop Until rFind.Address = rFirst.Address
    
    End If
End With

End Sub

 

[bat18]

You have no idea how much joy this is bringing me ha!!

Thanks to both of you!!