find text string on worksheet

Rasberry

Board Regular
Joined
Aug 11, 2002
Messages
158
I am looking at past questions, but can't figure out how to structure my code. I want to look through the worksheet for a specific test string: ROIC. Once I find it, then I want to copy the cell below it and paste it in another workbook.
 

Some videos you may like

Excel Facts

Is there a shortcut key for strikethrough?
Ctrl+S is used for Save. Ctrl+5 is used for Strikethrough. Why Ctrl+5? When you use hashmarks to count |||| is 4, strike through to mean 5.

Joe4

MrExcel MVP, Junior Admin
Joined
Aug 1, 2002
Messages
54,816
Office Version
  1. 365
Platform
  1. Windows
Here is some code that should do that. Adjust your workbook/sheet/range references as necessary.
Code:
Sub Macro1()

'   Error handling if it can't find value
    On Error GoTo err_chk
    
'   Find value and copy cell under it
    Cells.Find(What:="ROIC", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False).Offset(1, 0).Copy
        
'   Go to new location and paste
    Windows("Book2.xls").Activate
    Sheets("Sheet2").Activate
    Range("A1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    
    On Error GoTo 0
    Exit Sub
    
'   Error handling
err_chk:
    If Err.Number = 91 Then
        MsgBox "Cannot find the value ROIC on active sheet"
    Else
        MsgBox Err.Number & ": " & Err.Description
    End If
    
End Sub
 

HalfAce

MrExcel MVP
Joined
Apr 6, 2003
Messages
9,453
Hello Rasberry,
Here's something to give you some ideas.
Assumes:
1) there will only be one instance of what you're searching for in the worksheet
- or you just want to find the first instance of it.
2) The code will be run with the sheet to be searched as the active sheet.
3) The string to be searched for will not always be 'ROIC'.
Code:
Sub FindAndCopy()
Dim ValueToFind As String, fCell As Range
ValueToFind = InputBox("Enter the value to search for.", "Search for . . ")
Set fCell = Cells.Find(ValueToFind, lookat:=xlWhole)

If fCell Is Nothing Then
  MsgBox "'" & ValueToFind & "' can not be found in this sheet.", vbInformation, "Search Results"
Else
  fCell(2).Copy 'Your paste destination goes here.
End If

Application.CutCopyMode = False
End Sub


[EDIT:]
I see that Joe has already got something similar but there are enough differences
between these two suggestions to warrent posting this anyway.
 

Rasberry

Board Regular
Joined
Aug 11, 2002
Messages
158
Wonderful--that works mostly. I changed it a little bit. Perhaps I made it goof up. It works on the first 3 files, then on the next file, it doesn't go to the err_chk when it can't find ROIC. I'm wondering if the Find 'after activecell' is the problem. Here is the code:

Columns("A:A").Select
Selection.Find(What:="end", After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False).Activate
NumberOfFiles = ActiveCell.Row
Range("A4").Select
For I = 1 To NumberOfFiles - 1
DataGathering:
ActiveCell.Offset(1, 0).Select
Application.DisplayAlerts = False
Filename = ActiveCell.Value
Workbooks.Open Filename:="G:\analysis\MASTER\A\" & Filename
' Error handling if it can't find value
On Error GoTo err_chk

' Find value and copy cell under it
Cells.Find(What:="ROIC", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False).Offset(1, 0).Copy

' Go to new location and paste
Windows("Credit_Statistics_Report.xls").Activate
Sheets("StatSheet").Activate
ActiveCell.Select
ActiveCell.Offset(0, 8).Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveCell.Offset(0, -8).Select
Workbooks(Filename).Activate
ActiveWorkbook.Close
Next I
Application.DisplayAlerts = True
' Error handling
err_chk:
If Err.Number = 91 Then
MsgBox "Cannot find the value ROIC on active sheet"
Else
MsgBox Err.Number & ": " & Err.Description
End If
ActiveWorkbook.Close
Windows("Credit_Statistics_Report.xls").Activate
GoTo DataGathering
End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,111,490
Messages
5,541,028
Members
410,540
Latest member
FlaShow
Top