Home |
Search |
Today's Posts |
#1
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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 |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
Macro Help: Find Value, Cut and Paste Row | Excel Discussion (Misc queries) | |||
Special Paste to Next empty row if new data and mark copied Macro | Excel Discussion (Misc queries) | |||
Find and highlight results macro | Excel Programming | |||
Looping Macro to Find and Mark | New Users to Excel | |||
I need to find a macro to find data cut and paste to another colu. | Excel Programming |