LinkBack Thread Tools Search this Thread Display Modes
Prev Previous Post   Next Post Next
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 17
Default Find, highlight, mark, cut and paste macro

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

 
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Macro Help: Find Value, Cut and Paste Row harky Excel Discussion (Misc queries) 0 October 26th 11 01:37 PM
Special Paste to Next empty row if new data and mark copied Macro Madhart Excel Discussion (Misc queries) 0 August 29th 08 10:39 AM
Find and highlight results macro Mick Excel Programming 15 June 11th 05 06:28 PM
Looping Macro to Find and Mark Big Tony New Users to Excel 8 January 26th 05 09:07 PM
I need to find a macro to find data cut and paste to another colu. Rex Excel Programming 6 December 7th 04 09:22 AM


All times are GMT +1. The time now is 01:46 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"