Macro to find a cell with a specific word (when its mixed in with a sentence)

[sdoppke]

Hi everyone, im try to build a macro that will find a word within a sentence that is in a cell. i.e.

A1="store number 566" I need the macro to select that cell (and stop). After that I will insert the rest of the code to copy and paste a larger area from that point, into another worksheet.

Thanks everyone in advance for any help.

sd

 

[AlphaFrog]

Try something like this...

Sub Find_Word()
    
    Dim FindWord As String, Found As Range

    FindWord = [COLOR="Red"]"store number 566"[/COLOR]

    Set Found = Sheets("Sheet1").Cells.Find(What:=FindWord, _
                                            LookIn:=xlValues, _
                                            LookAt:=xlPart, _
                                            SearchOrder:=xlByRows, _
                                            SearchDirection:=xlNext, _
                                            MatchCase:=False)
                                        
    If Not Found Is Nothing Then
        Found.Select
    Else
        MsgBox "No match found."
    End If
        
End Sub

 

[sdoppke]

AlphaFrog thanks for teh fast reply! this is great, would you be able to help me modify your script to look through all open workbooks? also the im thinking to make it search faster (because there are 1000's of rows) could we set it up to search only column A in the open workbooks (thats were the data will be).

thanks a ton for your help. if youi happend to describe what you came up with, it wouild be really helpfull so i can learn and help others.

sd

 

[sdoppke]

Try something like this...

Sub Find_Word()
 
    Dim FindWord As String, Found As Range
 
    FindWord = [COLOR=red]"store number 566"[/COLOR]
 
    Set Found = Sheets("Sheet1").Cells.Find(What:=FindWord, _
                                            LookIn:=xlValues, _
                                            LookAt:=xlPart, _
                                            SearchOrder:=xlByRows, _
                                            SearchDirection:=xlNext, _
                                            MatchCase:=False)
 
    If Not Found Is Nothing Then
        Found.Select
    Else
        MsgBox "No match found."
    End If
 
End Sub

I thought i wuold post what i have so far:

Sub Business_Results()
    Dim FindWord As String, Found As Range
    FindWord = Sheets("MyStoreInfo").Range("B2")
    Set Found = Sheets("Sheet2").Cells.Find(What:=FindWord, _
                                            LookIn:=xlValues, _
                                            LookAt:=xlPart, _
                                            SearchOrder:=xlByRows, _
                                            SearchDirection:=xlNext, _
                                            MatchCase:=False)
                                        
    If Not Found Is Nothing Then
        Found.Select
        Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("Sheet3").Select
    Range("B4").Select
    ActiveSheet.Paste
    Range("B4").Select
    Else
        MsgBox "Cannot find store data..."
    End If

End Sub

Thanks again AlphaFrog

sd

 

[AlphaFrog]

...modify your script to look through all open workbooks?

So you want to copy the found store data from each open workbook to Sheet3. In that correct?

Do you want to search each worksheet in each open workbook or just Sheet2 in each workbook?

 

[sdoppke]

So you want to copy the found store data from each open workbook to Sheet3. In that correct?

Do you want to search each worksheet in each open workbook or just Sheet2 in each workbook?

that's exactly right. I need to be able to search all worksheets in all workbooks, column A only.

Sd

 

[sdoppke]

Do you want to search each worksheet in each open workbook or just Sheet2 in each workbook?

Ive tried to modify your script myself and seemed to have broken it all together LOL.

It would need to be able to seach all opend sheet on all open workbooks. The reason the search needs to be "all open" is becasue they change the file name every day (by date).

Hope that helps, and thanks for the help.

sd

 

[AlphaFrog]

Once a match is found on a given sheet, what exactly do you want copied (what cell range relative to the found match) and where exactly do you want it copied?

It looks like (but I'm not sure) you want to copy all rows starting from the match on down and pate them to the next empty row on Sheet3. Please clarify with details.

 

[sdoppke]

It looks like (but I'm not sure) you want to copy all rows starting from the match on down and pate them to the next empty row on Sheet3. Please clarify with details.

I was looking to use the:

Range(Selection, Selection.End(xlToRight)).Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.Copy
        Sheets("GRL Copy and Paste").Select
        Range("A1").Select
        ActiveSheet.Paste

to copy everything to the right and then everything from there, down (a large group of data that veries in size each time), then paste it to the "GRL Copy and Paste" WS.

thanks

sd

 

[AlphaFrog]

Sub Business_Results()

    Dim FindWord As String, Found As Range
    Dim wsDest As Worksheet, ws As Worksheet, wb As Workbook
    Dim Nextrow As Long, Lastrow As Long

    Set wsDest = ThisWorkbook.Sheets("Sheet3")
    FindWord = ThisWorkbook.Sheets("MyStoreInfo").Range("B2").Value
    
    Application.ScreenUpdating = False
    For Each wb In Application.Workbooks        ' Loop through each open workbook
        If wb.Name <> ThisWorkbook.Name Then    ' Exclude this workbook
            For Each ws In wb.Sheets            ' Loop through each worksheet of each workbook
                Set Found = ws.Range("A:A").Find(What:=FindWord, _
                                                 LookIn:=xlValues, _
                                                 LookAt:=xlPart, _
                                                 SearchOrder:=xlByRows, _
                                                 SearchDirection:=xlNext, _
                                                 MatchCase:=False)
                If Not Found Is Nothing Then
                    Nextrow = wsDest.Cells.Find("*", , , , xlByRows, xlPrevious).Row + 1 ' Next empty row on Sheet3
                    Lastrow = ws.Cells.Find("*", , , , xlByRows, xlPrevious).Row         ' Last used row on Store sheet
                    ' Copy\Paste found store data to the next empty row on Sheet3
                    ws.Range(Found, Found.End(xlToRight)).Resize(Lastrow - Found.Row + 1).Copy _
                        Destination:=wsDest.Range("B" & Nextrow)
                End If
            Next ws
        End If
    Next wb
    Application.ScreenUpdating = True
    MsgBox "Copy complete.", vbInformation, "Copy Store Data"

End Sub