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.?

Craig Freeman Wrote:
opps...Is there way to modify this to only search for whole words.?

Hi Craig! Sorry for the delay... I was away... Anywayz, look for the
line

Find(SearchStr, LookIn:=xlValues)

in the code (in sub FindAndCopy). This is what searches for the values.
Just replace it with:

Find(SearchStr, LookIn:=xlValues, *LookAt:=xlWhole*)

if you want to match whole words, or:

Find(SearchStr, LookIn:=xlValues, *LookAt:=xlPart*)

if you want partial matching.

This is the syntax for Find (from VBA Help):

Find(What, After, LookIn, LookAt, SearchOrder, SearchDirection,
MatchCase, MatchByte, SearchFormat)

*What* - the value you're looking for

*After* - the cell after w/c you want the search to begin

*LookIn* - set to *xlValues* if you want to search in the values
(what's displayed); set to *xlFormulas* if you want to search in the
formulas. (I'm not sure, but there probably are other options.)

*LookAt* - set to *xlWhole* to match whole words; set to *xlPart* for
partial matching

*MatchCase* - set to *True* if you want the search to be
case-sensitive; set to *False* for case-insensitive

:)


--
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

Hey T-®ex,

Really no delay at all...

The problem I was having with 'xlwhole' was that if there were two or
more whole words in the cell, the function would return no results,
even if there was a match with one of the whole words. So if I was
searching for 'apple', and 'candy apple' was in the cell, no match was
made. What I want to eliminate, is a search for 'andy' returning
'candy'.

Any ideas?

Cheers,
Craig

Hi Craig! You can actually use wildcard characters... Here's one way I
can think of.
In the previous code, replace the sub *FindAndCopy* with the new
*FindAndCopy* below and add the new function *MatchWhole*.


Code:
--------------------
'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, LookAt:=xlPart)

If Not FoundVal Is Nothing Then
FirstAddress = FoundVal.Address

Do
If MatchWhole(SearchStr, FoundVal.Value) Then
CopyToResultSheet FoundVal.EntireRow
End If

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

'Returns True if SearchString matches a "whole" word in Val, that is,
'SearchString either fully matches Val, or SearchString is a substring
'in Val immediately preceded or followed by 0 or 1 non-alphanumeric character,
'then preceded or followed by any number of characters.
Function MatchWhole(ByVal SearchString As Variant, ByVal Val As Variant, Optional ByVal CaseSensitive As Boolean = False) As Boolean
Dim RegExp1 As String
Dim RegExp2 As String
Dim RegExp3 As String
Dim RegExp4 As String

If Not CaseSensitive Then
SearchString = UCase(SearchString)
Val = UCase(Val)
End If

'match whole word
RegExp1 = SearchString

'match starting, followed by non-alphanumeric character, followed by any character
' "andy" matches "andy abc"
' "andy" matches "andy-123"
' "andy" matches "andy,abc"
' "andy" matches "andy.123"
' "andy" does not match "t andy"
' "andy" does not match "andy123"
' "andy" does not match "andyt"
' "andy" does not match "candy"
' etc...
RegExp2 = SearchString & "[!a-zA-Z0-9]*"

'match ending, preceded by non-alphanumeric character, preceded by any character
' "andy" matches "abc andy"
' "andy" matches "123-andy"
' "andy" matches "abc,andy"
' "andy" matches "123.andy"
' "andy" does not match "andy t"
' "andy" does not match "123andy"
' "andy" does not match "andyt"
' "andy" does not match "candy"
' etc...
RegExp3 = "*[!a-zA-Z0-9]" & SearchString

'match starting, followed by non-alphanumeric character, followed by any character AND
'match ending, preceded by non-alphanumeric character, preceded by any character
' "andy" matches "abc andy-123"
' "andy" matches ".andy,"
' "andy" matches "abc,andy?"
' "andy" matches "123.andy "
' "andy" does not match "andy t"
' "andy" does not match "123andy"
' "andy" does not match "andyt"
' "andy" does not match "candy"
' etc...
RegExp4 = "*[!a-zA-Z0-9]" & SearchString & "[!a-zA-Z0-9]*"

If (Val Like RegExp1) Or _
(Val Like RegExp2) Or _
(Val Like RegExp3) Or _
(Val Like RegExp4) Then
MatchWhole = True
Else
MatchWhole = False
End If
End Function
--------------------


Hope this helps... :)


Craig Freeman Wrote:
Hey T-=AEex,

Really no delay at all...

The problem I was having with 'xlwhole' was that if there were two or
more whole words in the cell, the function would return no results,
even if there was a match with one of the whole words. So if I was
searching for 'apple', and 'candy apple' was in the cell, no match was
made. What I want to eliminate, is a search for 'andy' returning
'candy'.

Any ideas?

Cheers,
Craig


--
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

Great! I appreciate all your help.

take care,
Craig