Hello,

I'm hoping that what I want to do is possible, as it would save me a
great deal of time.

I have a worksheet, we can call it 'data', that contains several
thousand rows of data. What I'd like to do, is allow the user to enter
their text string in an inputbox, search entire datasheet (excluding
header a1), and when a match is found, for that entire row to be
highlighted (yellow), and an "yes" indicator to be place in the last
column of datasheet - say column 'f'. (doing nothing if no match is
made)

As the final step, I'd like at the same time for that row (and if
possible the row number) to copied to a separate 'results' sheet
(allowing for header a1), and place the users search string in column
'g'. Any subsequent searches would need to append to the results sheet
(ie. leave data from previous search).

I got the folloing code from a previous post, but only does half of
what I want it to do.

Any help is greatly appreciated.

Sub FindValueAndCopy()

On Error GoTo HANDLEERROR

'** prompts user on what to find
Prompt = "What do you want to find ?"
Title = "Find"
ValueToFind = InputBox(Prompt, Title)
If ValueToFind = "" Then End


' can name sheet what ever you want
' ** MAKE SURE YOU HAVE A SHEET WITH THIS NAME **
SheetToCopyTo = "Values Found"


TotalNumberOfSheet = Sheets.Count
NumFound = 0
For s = 1 To TotalNumberOfSheet
'** scrolls through Sheet by Sheet
Sheets(s).Select
If ActiveSheet.Name = SheetToCopyTo Then GoTo SKIP


'** Searches for value entered
Set Search = Cells.Find(What:=ValueToFind, _
LookIn:=xlValue)
If Search Is Nothing _
Then
Message = ValueToFind & " was NOT found on " & _
ActiveSheet.Name
m = MsgBox(messgae, vbInformation, "Not Found")
Else
FirstFoundAddress = Search.Address
Do
' highlights Entire row as color Yellow
NumFound = NumFound + 1
Rows(Search.Row).Select
With Selection.Interior
.ColorIndex = 6 ' 6 = yellow
.Pattern = xlSolid
End With
' copies entire row to default sheet to
' copy to
Selection.Copy
Sheets(SheetToCopyTo).Select
Cells(NumFound, 1).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Sheets(s).Select
' finds next value
Set Search = Cells.FindNext(Search)
Loop While Not (Search Is Nothing) And Search.Address <
FirstFoundAddress
End If
SKIP:
Next s


'***** Handles Errors *****
Exit Sub
HANDLEERROR: ErrorMessage = "ERROR " & Err.Number & " - " &
Err.Description
m = MsgBox(ErrorMessage, vbCritical, "Error")
Err.Clear
End


End Sub

Hello,

Sorry, I need to refine my requirements a little...I no longer require
for the entire row to be highlighted (yellow), and an "yes" indicator
to be place in the last column of datasheet. I only require the row
for the match string to be copied and appended to results sheet, along
with copying the search string itself to column 'g' of the results
sheet. Additionally, if I could have the user specify which column to
search in the data sheet instead of searching the entire row...that
would be great.

Is this possible?

Craig

budabump...anyone?

Hi Craig! Try this...

Put the following in a module...


Code:
--------------------
Option Explicit

Const rtDataSheet As String = "Data Sheet" 'Change to actual data sheet tab name
Const rtResultSheet As String = "Result Sheet" 'Change to actual result sheet tab name

Dim ColName As String
Dim SearchStr As String

'Main subroutine...
Sub FindAndCopy()
SearchStr = InputBox("Enter search string:", "Find")

If SearchStr = "" Then Exit Sub

ColName = GetColName(InputBox("Under what column would you want to search?", "Column Name/Number", "A"))

If ColName = "" Then Exit Sub

Dim SearchRange As Range
Set SearchRange = Worksheets(rtDataSheet).Range(ColName & "2:" & ColName & "65536") '2 - exclude 1st row

'The following codes are a modified version of the 'Find' method example from the VBA Help
Dim FoundVal As Range
Dim FirstAddress As String

With SearchRange
Set FoundVal = .Find(SearchStr, LookIn:=xlValues)

If Not FoundVal Is Nothing Then
FirstAddress = FoundVal.Address

Do
CopyToResultSheet FoundVal.EntireRow
Set FoundVal = .FindNext(FoundVal)
Loop While (Not FoundVal Is Nothing) And (FoundVal.Address < FirstAddress)
End If
End With
End Sub

'Returns the column name for the specified column number.
Function GetColName(ByVal ColNum As String) As String
'Excel (as of this version) only holds up to 256 columns (from A - IV)
Dim ColName As String
ColName = "<OVERFLOW"

If IsNumeric(ColNum) Then
If (ColNum = 1) And (ColNum <= 256) Then
ColName = ""

If ColNum 26 Then
ColName = Chr((Asc("A") - 1) + Int((ColNum - 1) / 26))
End If

ColName = ColName & Chr(Asc("A") + ((ColNum - 1) Mod 26))
End If
Else
ColName = ColNum
End If

GetColName = ColName
End Function

'Copies the found values to result sheet
'It is assumed that columns G and H are empty in data sheet
Sub CopyToResultSheet(ByVal FoundVal As Range)
Dim LastRow As Long
LastRow = GetRSLastRow

FoundVal.Copy Worksheets(rtResultSheet).Range("A" & LastRow + 1)
Worksheets(rtResultSheet).Range("G" & LastRow + 1).Value = "Search String: " & SearchStr
Worksheets(rtResultSheet).Range("H" & LastRow + 1).Value = "From " & rtDataSheet & " Cell " & ColName & FoundVal.Row
End Sub

'Gets the last occupied row in result sheet
Function GetRSLastRow() As Long
Dim RowRange As Range
Set RowRange = Worksheets(rtResultSheet).Range("A65536").End(xlUp )

GetRSLastRow = RowRange.Row
End Function
--------------------


Craig Freeman Wrote:
budabump...anyone?


--
T-®ex
------------------------------------------------------------------------
T-®ex's Profile: http://www.excelforum.com/member.php...o&userid=26572
View this thread: http://www.excelforum.com/showthread...hreadid=401201

Wow...that's great great T-®ex! It works perfectly. I can't thank you
enough.

Take care,
....thanks again :)
Craig

opps...Is there way to modify this to only search for whole words.?