vbs for search help

krrthree

New Member
Joined
Oct 24, 2011
Messages
2
Good evening. I have a 3 sheets. Sheet one contains multiple columns and rows. Sheet 2 is empty, and sheet 3 contains a column of values to search for in column c of sheet one. The following script works with one exception. It only gets the first row with that value and i need it to list all values in column c to return to sheet 2.

Here is the script I am using.

Option Explicit
Sub GeneFinder()
Dim srchLen, gName, nxtRw As Integer
Dim g As Range
'Clear Sheet 2 and Copy Column Headings
Sheets(2).Cells.ClearContents
Sheets(1).Rows(1).Copy Destination:=Sheets(2).Rows(1)
'Determine length of Search Column from Sheet3
srchLen = Sheets(3).Range("A" & Rows.Count).End(xlUp).Row
'Loop through list in Sheet3, Column A. As each value is
'found in Sheet1, Column D, copy it top the next row in Sheet2
With Sheets(1).Columns("C")
For gName = 2 To srchLen
Set g = .Find(Sheets(3).Range("A" & gName), lookat:=xlWhole)
If Not g Is Nothing Then
nxtRw = Sheets(2).Range("D" & Rows.Count).End(xlUp).Row + 1
g.EntireRow.Copy Destination:=Sheets(2).Range("A" & nxtRw)
End If
Next
End With
End Sub


I don't know how to edit this script in order to get it to return all equal values.

Thanks in advance.
Kenneth
 

Excel Facts

Move date out one month or year
Use =EDATE(A2,1) for one month later. Use EDATE(A2,12) for one year later.

AlphaFrog

MrExcel MVP
Joined
Sep 2, 2009
Messages
16,402
Code:
Sub GeneFinder()
    Dim srchLen, gName, nxtRw As Integer
    Dim g      As Range
    [COLOR="Red"]Dim FirstFound As String[/COLOR]
    'Clear Sheet 2 and Copy Column Headings
    Sheets(2).Cells.ClearContents
    Sheets(1).Rows(1).Copy Destination:=Sheets(2).Rows(1)
    'Determine length of Search Column from Sheet3
    srchLen = Sheets(3).Range("A" & Rows.Count).End(xlUp).Row
    'Loop through list in Sheet3, Column A. As each value is
    'found in Sheet1, Column D, copy it top the next row in Sheet2
    With Sheets(1).Columns("C")
        For gName = 2 To srchLen
            Set g = .Find(Sheets(3).Range("A" & gName), lookat:=xlWhole)
            If Not g Is Nothing Then
               [COLOR="Red"] FirstFound = g.Address
                Do[/COLOR]
                    nxtRw = Sheets(2).Range("D" & Rows.Count).End(xlUp).Row + 1
                    g.EntireRow.Copy Destination:=Sheets(2).Range("A" & nxtRw)
                    [COLOR="Red"]Set g = .FindNext(g)
                Loop Until g.Address = FirstFound[/COLOR]
            End If
        Next
    End With
End Sub
 

krrthree

New Member
Joined
Oct 24, 2011
Messages
2
AlphaFrog

I have had this post up for about 3 hours on two other forums, and you knocked it out quick.

I really appreciate your help.

It is exactly what i have been looking for.

THANKS!!:)
 

AlphaFrog

MrExcel MVP
Joined
Sep 2, 2009
Messages
16,402
You're welcome.

As a courtesy, reply to the other forums with some sort of "question answered".
 

Watch MrExcel Video

Forum statistics

Threads
1,130,102
Messages
5,640,115
Members
417,126
Latest member
Jeffman52

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top