Searching text, creating list on new sheet.

[moheganburner]

Hi guys. I have no VB experience, so I'm thinking that is why I can't figure this out on my own. On Sheet1, Column H has different people's names going all the way down. Some names appear many times in different rows, some names appear with other names in the same cell. Column A is a list of unique serial numbers, with every serial number appearing only once in the column. I want to search Column H for a guy's name "Joe", and for every row he appears in (regardless if his cell is shared by two other people) I want to output the corresponding serial number from Column A. I have a new sheet in this workbook called "Joe" and I want to create a list of just his relevant serial numbers.

Bonus question... instead of outputting this to a new sheet, how can I creat a "Joe" button on Sheet1 that will make a text box popup with this output listed?

Thanks MrExcel, for having this great forum.

MB

 

[BrianB]

A bit much to cover in one go. This should help you on your way

http://www.mrexcel.com/board2/viewtopic.php?t=150953&highlight=

 

[moheganburner]

Brian, thanks a lot. That is a huge help. How can I set boundaries for the "summary" cells? This code outputs the summary into A1 and then lists the results all the way down the A column. How do I get it to output the results in cells B3 through H20 only (assuming the found data does not exceed that number of cells)? I tried putting different code in to define "ToRow", but no luck.

One other thing, this code seems to only copy the first instance of "Joe". Instead of listing the 95 different serial numbers for "Joe", it lists only the first serial number 95 times.

 

[BrianB]

Don't really understand what you mean by limiting the results to B3:h20.

Lets get the other working first.
Replace your code section with this -which limits the search to column H and extracts the name from column H and whatever is in column A.

Then copy/paste *your* version of the code in a message saying what is not working yet.

    '---------------------------------------------------
    ' FIND DATA
    With FromSheet.Columns("H").Cells
        Set FoundCell = .Find(What:=FindThis, LookIn:=xlValues)
        If Not FoundCell Is Nothing Then
            FirstAddress = FoundCell.Address
            FromRow = FoundCell.Row
            '------------------------------------------
            '- copy data to summary
            Do
                ToSheet.Cells(ToRow, 1).Value = _
                        FromSheet.Cells(FromRow, 8).Value
                ToSheet.Cells(ToRow, 2).Value = _
                        FromSheet.Cells(FromRow, 1).Value
                ToRow = ToRow + 1
                Set FoundCell = .FindNext(FoundCell)
            Loop While Not FoundCell Is Nothing And _
                FoundCell.Address <> FirstAddress
            '------------------------------------------
        End If
    End With

 

[moheganburner]

Here's my code so far:

_________________________________________________________________
Sub Name()
Dim FromSheet As Worksheet
Dim FromRow As Long
Dim ToSheet As Worksheet
Dim ToRow As Long
Dim FindThis As Variant
Dim FoundCell As Object

Application.Calculation = xlCalculationManual
Set FromSheet = ThisWorkbook.Worksheets("SUST")
Set ToSheet = ThisWorkbook.Worksheets("SUST")
ToRow = 475

FindThis = InputBox("Please enter name for relevance search : ")
If FindThis = "" Then End

With FromSheet.Columns("H").Cells
Set FoundCell = .Find(FindThis, LookIn:=xlValues)
If Not FoundCell Is Nothing Then
FirstAddress = FoundCell.Address
FromRow = FoundCell.Row

Do
ToSheet.Cells(ToRow, 2).Value = _
FromSheet.Cells(FromRow, 1).Value
ToRow = ToRow + 1
Set FoundCell = .FindNext(FoundCell)
Loop While Not FoundCell Is Nothing And _
FoundCell.Address <> FirstAddress

End If
End With
Application.Calculation = xlCalculationAutomatic
End Sub
_________________________________________________________________

I only want to search in Column H, don't want to output anything from it. I just want the corresponding A cells to be copied down below on the same page. This code takes all the cells in Column "A" that have the searched name found in Column "H" and copies them to a tall list beginning in B475. The problems are that the search finds only the first occurence of the name, and lists the corresponding Column A value 95 times. I should have a list of 95 unique column A values. Also, instead of one tall list of 95 beginning in B475, can I have the ouput listed in something like B475:R495?

 

[BrianB]

I think this is what you want. It puts the found values in the next empty cell of your specified range. You will get an error if there are more values than the range can hold. I had to change the name of your routine slightly because "Name" is a reserved word in VBA, and it produced a runtime error.

Sub NameX()
    Dim FromSheet As Worksheet
    Dim FromRow As Long
    Dim ToSheet As Worksheet
    Dim ToRange As Range
    Dim ToCell As Integer
    Dim FindThis As Variant
    Dim FoundCell As Object
    '---------------------------------------------------------------
    Application.Calculation = xlCalculationManual
    Set FromSheet = ThisWorkbook.Worksheets("SUST")
    Set ToSheet = ThisWorkbook.Worksheets("SUST")
    Set ToRange = ToSheet.Range("B475:R495")
    ToCell = 1
    '---------------------------------------------------------------
    FindThis = InputBox("Please enter name for relevance search : ")
    If FindThis = "" Then End
    '---------------------------------------------------------------
    With FromSheet.Columns("H").Cells
        Set FoundCell = .Find(FindThis, LookIn:=xlValues)
        If Not FoundCell Is Nothing Then
            FirstAddress = FoundCell.Address
            '- loop
            Do
                FromRow = FoundCell.Row
                ToRange.Cells(ToCell).Value = _
                FromSheet.Cells(FromRow, 1).Value
                ToCell = ToCell + 1
                Set FoundCell = .FindNext(FoundCell)
            Loop While Not FoundCell Is Nothing And _
                FoundCell.Address <> FirstAddress
        End If
    End With
    '----------------------------------------------------------------
    Application.Calculation = xlCalculationAutomatic
End Sub

 

[moheganburner]

Awesome BrianB! It works like a charm.

Thank you!
MB

 

[moheganburner]

Brian, time to make some adjustments. Here is my final working code (sorry, but I can't install the html maker at work):

Private Sub CommandButton1_Click()
Dim FromSheet As Worksheet
Dim FromRow As Long
Dim ToSheet As Worksheet
Dim ToCell As Integer
Dim FindThis As Variant
Dim FoundCell As Object

Application.Calculation = xlCalculationManual
Set FromSheet = ThisWorkbook.Worksheets("SUST")
Set ToSheet = ThisWorkbook.Worksheets("SUST")
Set ToRange = ToSheet.Range("C100:M150")
ToCell = 1

FindThis = "Joe"

Sheets("SUST").Range("C100:M150").ClearContents
Sheets("SUST").Range("C99").ClearContents
Sheets("SUST").Range("C99").Value = FindThis

With FromSheet.Columns("H").Cells
Set FoundCell = .Find(FindThis, LookIn:=xlValues)
If Not FoundCell Is Nothing Then
FirstAddress = FoundCell.Address
FromRow = FoundCell.Row

Do
FromRow = FoundCell.Row
ToRange.Cells(ToCell).Value = _
FromSheet.Cells(FromRow, 1).Value
ToCell = ToCell + 1
Set FoundCell = .FindNext(FoundCell)
Loop While Not FoundCell Is Nothing And _
FoundCell.Address <> FirstAddress

End If
End With
Application.Calculation = xlCalculationAutomatic
End Sub

Which does exactly what I needed it to (thanks!). Now, there is another column "E", and if the word "pay" appears in this column, I don't want the corresponding value in the "A" column to move to my list in C100:M150. So, if "Joe" appears in "H4", and "pay" appears in "E4", I don't want the value of "A4" to go to the list. Seems like I need an IF/ELSE statement inside the DO statement, but I am at a loss.

Also, this is one of 15 buttons. My ToRange changes every other day. Can I create a subroutine that only defines the ToRange, then call that range into each of the buttons? That way, instead of changing the 15 buttons every time, I can just change the ToRange subroutine.

Thanks!
MB

 

[BrianB]

I think this is it :-

Do
    FromRow = FoundCell.Row
    If FromSheet.Cells(FromRow, 5).Value <> "pay" Then
        ToRange.Cells(ToCell).Value = _
            FromSheet.Cells(FromRow, 1).Value
        ToCell = ToCell + 1
    End If
    Set FoundCell = .FindNext(FoundCell)
Loop While Not FoundCell Is Nothing And _
FoundCell.Address <> FirstAddress

html maker

Just select your code in the message and click the grey "Code" button over the box.

If you do not mind selectiing the target range before running the code you could change this line to :-

Set ToRange = Selection

Or use one of the numerous ways to get a string (eg.cell ref, inputbox)
and use

    Dim MyRange As String
    MyRange = "C100:M150"
    Set ToRange = ToSheet.Range(MyRange)

 

[moheganburner]

Thanks for the help man, I really appreciate all of it!

MB