Partial Text Lookup

[wrightyrx7]

Hi all just been watchin the new videos on youtube and seen the partial text lookup video that may come in handy at work.

Problem is its on multiple Worksheets. Let me explain....

What i do I log forms onto seperate worksheets as they come into the office.
Columns consist of:-
-Employee Number
-First Name
-Surname
-Date Recieved
-Form Type
-Date Completed
-Completed By

So i log these forms and when someone completes a form they fill in the -Date Completed & -Completed by column.

So as you might of guessed each worksheet after a while is getting longer and longer. And when an employee contacts me to see where their forms are upto i have to flick through the worksheets using CTRL+F to see if they are on that worksheet. Which is a pain in the backside.

I was wondering if anyone could help me put something on a blank worksheet to seach by employee number and it bring back all the results no matter what worksheet the information is on?


Hope i have explained it clear enough, please ask if you need any more information.

Thanks in advance

Chris

 

[pboltonchina]

Try this on a copy of your data.

Private Function SheetExists(Sheetname As String) As Boolean
    ' Returns TRUE if a sheet exists in the active workbook
    Dim x As Worksheet
        On Error Resume Next
            Set x = ActiveWorkbook.Sheets(Sheetname)
                If Err = 0 Then SheetExists = True _
                Else SheetExists = False
End Function

Sub FindAllSheets()
    Dim Found As Range, ws As Worksheet, LookFor As Variant
        LookFor = InputBox("Enter value to find")
            
            If LookFor = "" Then Exit Sub
            
            '   Clear or Add a Results sheet
            If SheetExists("Search Results") Then
              Sheets("Search Results").Activate
              Range("A2").Select
              Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
              Selection.ClearContents
            Else
                Sheets.Add After:=Sheets(Sheets.count)
                ActiveSheet.Name = "Search Results"
            End If
            
            For Each ws In ActiveWorkbook.Worksheets
                If ws.Name <> "Search Results" Then
                     Set Found = ws.Cells.Find(What:=LookFor)
                     If Found Is Nothing Then
                         Range("D5").Select
                     Else
                         Found.EntireRow.Copy Sheets("Search results").Cells(Rows.count, "A").End(xlUp).Offset(1)
                     End If
                End If
            Next ws
End Sub

 

[wrightyrx7]

Hi Pboltonchina, Thank you so much for the quick reply.

Im sorry im not very good with VBA, am i putting this on a worksheet or on the workbook?

Thanks
Chris
http://www.mrexcel.com/forum/member.php?u=94449

 

[wrightyrx7]

Forget that i figured it out.... WOW thats was quick and does exactly what i want! Your an absolute star!!

Thanks Again

ps. Will this work with Excel 2003? Thats what they have at work

 

[pboltonchina]

Press Alt & F11 together to open up the VBA window, on the left hand side of the window you will see a list that contains your workbook name. Right click your workbook name and select 'Insert' then 'Module' then paste my code into the large right hand section of the window. Click the big red cross int he top right hand corner of the screen to close the VBA window. Then select 'View' and 'Macros' and a window pops up with the name of the macro in it. Double click it and off you go.

HTH
Paul

 

[pboltonchina]

Yes it was written for 2003

 

[wrightyrx7]

I assigned the macro to a image and it works like a gem. Its a real time saver.

I might be pushing my luck but is the a way that if a form had not been completed (has no values in the -Date Completed or -Compleded by) then font colour of that row is red?

Thank you
Chris

 

[pboltonchina]

Which columns are those values in?

 

[wrightyrx7]

F and G

 

[pboltonchina]

Try something like this

    Dim LR As Long, i As Long
LR = Range("F" & Rows.count).End(xlUp).Row
For i = LR To 1 Step -1
    If Range("F" & i).Value = "" Or Range("G" & i).Value = "" Then Rows(i).Font.ColorIndex = 3