Find text from Cell in a Column and Retrieve row # and paste the information.

[Shreesurya]

Please help!

I want to search a text from a cell in a column and find out Row # and paste the row number in next sheet and copy paste whole row next to that.

Eg. [TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]Text String[/TD]
[TD]Row #[/TD]
[TD]Table info[/TD]
[TD]Table Info[/TD]
[/TR]
[TR]
[TD]Account[/TD]
[TD]2[/TD]
[TD][TABLE="width: 237"]
<tbody>[TR]
[TD="class: xl65, width: 237"]EscrowAccountStatementDate[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[TD][TABLE="width: 279"]
<tbody>[TR]
[TD="class: xl65, width: 279"]date on which escrow statements are sent[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[/TR]
[TR]
[TD]Account[/TD]
[TD]3[/TD]
[TD][TABLE="width: 237"]
<tbody>[TR]
[TD="class: xl65, width: 237"]EscrowAccountComputeDate[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[TD][TABLE="width: 279"]
<tbody>[TR]
[TD="class: xl65, width: 279"]Date on which escrow account is computed[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[/TR]
</tbody>[/TABLE]

Below is the raw data for your reference.

Note: It should split the text from the cell and search, Example: in first cell it says Institution Number - so it should be 3 way search like below. and loop for every cell in A Column and search in both B & C Column.

1. Institution
2. Number
3. Institution Number

[TABLE="class: grid, width: 740"]
<colgroup><col><col><col></colgroup><tbody>[TR]
[TD]EDW Field Description[/TD]
[TD]Copasysfieldname[/TD]
[TD]Field description[/TD]
[/TR]
[TR]
[TD]Institution Number[/TD]
[TD]EscrowAccountComputeDate[/TD]
[TD]Date on which escrow account is computed[/TD]
[/TR]
[TR]
[TD]Account Number[/TD]
[TD]EscrowAccountStatementDate[/TD]
[TD]date on which escrow statements are sent[/TD]
[/TR]
[TR]
[TD]Close Code[/TD]
[TD]EscrowAdvanceBalance[/TD]
[TD]Escrow advance balance amount [/TD]
[/TR]
[TR]
[TD]Credit Insurance Payment Amount[/TD]
[TD]EscrowAnalysisDate[/TD]
[TD]Escrow analysis date[/TD]
[/TR]
[TR]
[TD]Principal Balance[/TD]
[TD]EscrowAnalysisDisbursmentAmount[/TD]
[TD]Escrow Disbursement amount [/TD]
[/TR]
[TR]
[TD]C Info Seg Indr[/TD]
[TD]EscrowAnalysisShortAmount[/TD]
[TD]Shortage amount in escrow analysis[/TD]
[/TR]
[TR]
[TD]Escrow Balance[/TD]
[TD]EscrowBalance[/TD]
[TD]Escrow balance amount[/TD]
[/TR]
[TR]
[TD]Payoff Penalty Flag[/TD]
[TD]EscrowBorrowerContactDate[/TD]
[TD]Escrow borrower contact data[/TD]
[/TR]
[TR]
[TD]Last Activity Date[/TD]
[TD]EscrowCityTaxAmount[/TD]
[TD]Escrow city tax amount[/TD]
[/TR]
[TR]
[TD]Last Activity Date Nbr[/TD]
[TD]EscrowCityTaxDate[/TD]
[TD]Escrow city tax date[/TD]
[/TR]
</tbody>[/TABLE]


In need of desperate Help.

 

[DanteAmor]

Put your data in Sheet1 like this:

Excel Workbook
	A	B	C
1	EDW Field Description	Copasysfieldname	Field description
2	Institution Number	EscrowAccountComputeDate	Date on which escrow account is computed
3	Account Number	EscrowAccountStatementDate	date on which escrow statements are sent
4	Close Code	EscrowAdvanceBalance	Escrow advance balance amount
5	Credit Insurance Payment Amount	EscrowAnalysisDate	Escrow analysis date
6	Principal Balance	EscrowAnalysisDisbursmentAmount	Escrow Disbursement amount
7	C Info Seg Indr	EscrowAnalysisShortAmount	Shortage amount in escrow analysis
8	Escrow Balance	EscrowBalance	Escrow balance amount
9	Payoff Penalty Flag	EscrowBorrowerContactDate	Escrow borrower contact data
10	Last Activity Date	EscrowCityTaxAmount	Escrow city tax amount
11	Last Activity Date Nbr	EscrowCityTaxDate	Escrow city tax date
sheet1

In Sheet2, in cell B1 put the text to search, the result will be like this:

Excel Workbook
	A	B	C	D
1	Text:	Institution Number
2
3	Text String	Row #	Table info	Table Info
4	Institution Number	2	EscrowAccountComputeDate	Date on which escrow account is computed
5	Account Number	3	EscrowAccountStatementDate	date on which escrow statements are sent
Sheet2

Try this code:

Sub Find_Text()
    Dim sh1 As Worksheet, sh2 As Worksheet
    Dim wText As String, wTexts As New Collection, wpaso As Variant
    Dim b As Range, r As Range, celda As String
    Dim i As Double, j As Double
    '
    Set sh1 = Sheets("Sheet1")
    Set sh2 = Sheets("Sheet2")
    
    sh2.Rows("4:" & Rows.Count).ClearContents
    sh2.Columns("Z").ClearContents
    
    wText = sh2.Range("B1")
    If wText = "" Then
        MsgBox "Enter a text"
        Exit Sub
    End If
    
    wTexts.Add wText
    wpaso = Split(wText, " ")
    For i = LBound(wpaso) To UBound(wpaso)
        wTexts.Add wpaso(i)
    Next
    
    j = 4
    For i = 1 To wTexts.Count
        Set r = sh1.Columns("A")
        Set b = r.Find(wTexts(i), LookAt:=xlPart, LookIn:=xlValues)
        If Not b Is Nothing Then
            celda = b.Address
            Do
                'detalle
                If sh2.Cells(b.Row, "Z").Value = "" Then
                
                    sh2.Cells(j, "A").Value = sh1.Cells(b.Row, "A").Value
                    sh2.Cells(j, "B").Value = b.Row
                    sh2.Cells(j, "C").Value = sh1.Cells(b.Row, "B").Value
                    sh2.Cells(j, "D").Value = sh1.Cells(b.Row, "C").Value
                    sh2.Cells(b.Row, "Z").Value = "x"
                    j = j + 1
                    
                End If
                Set b = r.FindNext(b)
            Loop While Not b Is Nothing And b.Address <> celda
        End If
    Next
    sh2.Columns("Z").ClearContents
    
    MsgBox "Finish"
    
End Sub

 

[Shreesurya]

Thank you so much Dante Amor, I tried that with my excel however its not providing the desired result. I have linked the workbook which would help you to help me

https://drive.google.com/open?id=1Rv69w9IRFgyVZyDpz85kkPx5-j7l0GwO

it has to loop every cell in A Column for text and search it in B & C Column and provide the result in Sheet 2 (Result)

Thank you.

 

[DanteAmor]

I still do not understand, you could explain step by step a couple of examples of what you sent in the file, that is:
- I go to the sheet x
- I take the data y
- I look for it in the sheet z in the column w
- If I find it I take the data from column xx of the sheet yy and I paste it on the sheet zz in the column ww

Change x, y, z, w, xx, yy , zz , ww by the real data, using your example.

 

[Shreesurya]

I am sorry for the confusion Dante.

Below are the steps which might help you.

Step 1 - Go to Raw Data Sheet, Pick data from Cell A2 and Search in B & C Column
Step 2 - If found copy the Whole row and paste it in next Page "Result"
Step 3 - then Go to cell A3 in Raw data and repeat above steps and it should loop to next cells from A Column.

While Pasting the row. it should also paste the search string in the same row and row number as a reference.

Hope this helps... and thank you so much for spending time for this..

 

[DanteAmor]

Well, you did not explain with sample data, but try the following:

Sub Find_Text()
    Dim sh1 As Worksheet, sh2 As Worksheet
    Dim wText As String, wTexts As New Collection, wpaso As Variant
    Dim b As Range, r As Range, celda As String
    Dim i As Double, j As Double, lr As Double, w As Double
    '
    Set sh1 = Sheets("Raw Data")
    Set sh2 = Sheets("Result")
    
    sh2.Rows("2:" & Rows.Count).ClearContents
    'sh2.Columns("Z").ClearContents
    
    j = 2
    lr = sh1.Range("A" & Rows.Count).End(xlUp).Row
    For i = 2 To lr
        
        'sh2.Columns("Z").ClearContents
        wText = sh1.Cells(i, "A")
        wTexts.Add wText
        wpaso = Split(wText, " ")
        For w = LBound(wpaso) To UBound(wpaso)
            wTexts.Add wpaso(w)
        Next
        
        For h = 1 To wTexts.Count
            Set r = sh1.Columns("B:C")
            que = wTexts(h)
            Set b = r.Find(wTexts(h), LookAt:=xlPart, LookIn:=xlValues)
            If Not b Is Nothing Then
                celda = b.Address
                Do
                    'detalle
                    If b.Row > 1 Then
                        'If sh2.Cells(b.Row, "Z").Value = "" Then
                        
                            sh2.Cells(j, "A").Value = wTexts(h) & " (" & sh1.Cells(i, "A").Value & ")"
                            sh2.Cells(j, "B").Value = b.Row
                            sh2.Cells(j, "C").Value = sh1.Cells(b.Row, "B").Value
                            sh2.Cells(j, "D").Value = sh1.Cells(b.Row, "C").Value
                            'sh2.Cells(b.Row, "Z").Value = "x"
                            j = j + 1
                            
                        'End If
                    End If
                    Set b = r.FindNext(b)
                Loop While Not b Is Nothing And b.Address <> celda
            End If
        Next
        
        For y = wTexts.Count To 1 Step -1
            wTexts.Remove (y)
        Next
        
    Next
    'sh2.Columns("Z").ClearContents
    
    MsgBox "Finish"
    
End Sub

 

[Shreesurya]

You are really Suberb Dante! Macro worked as intended...

Thank you so Much...

 

[DanteAmor]

I'm glad to help you. I appreciate your kind comments.