Search for values in a sheet and copy found records one after theother in another sheet

[AndreasHermle]

Dear Experts:

Below macro ...
(1)... creates a user-defined search dialog box and ...
(2)... searches for data records that are listed in a
'xlsheetveryhidden'-worksheet (Sheet name = list)... and
(3)... if found, the data record is copied into the active cell of the
current worksheet.

I would like to have this macro rewritten so that ...
.... Excel copies the first instance of a found value/data record right
into row 1 of the current worksheet. Subsequent hits should then be
copied into row 2, row 3 etc. and so forth no matter which cell is
activated.

Is this possible? Help is very much appreciated. Thank you very much
in advance.

Regards, Andreas


Sub Find_it_and_copy_it()
Dim varWhat
Dim rngfound As Range
varWhat = Application.InputBox("Enter text to find")
Set rngfound = Sheets("list").Cells.Find(what:=varWhat,
LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False)
If Not rngfound Is Nothing Then
rngfound.EntireRow.Copy Cells(ActiveCell.Row, 1)
End If
End Sub

 

[Per Jessen]

Dear Experts:

Below macro ...
(1)... creates a user-defined search dialog box and ...
(2)... searches for data records that are listed in a
'xlsheetveryhidden'-worksheet (Sheet name = list)... and
(3)... if found, the data record is copied into the active cell of the
current worksheet.

I would like to have this macro rewritten so that ...
... Excel copies the first instance of a found value/data record right
into row 1 of the current worksheet. Subsequent hits should then be
copied into row 2, row 3 etc. and so forth no matter which cell is
activated.

Is this possible? Help is very much appreciated. Thank you very much
in advance.

Regards, Andreas

Sub Find_it_and_copy_it()
   Dim varWhat
   Dim rngfound As Range
   varWhat = Application.InputBox("Enter text to find")
   Set rngfound = Sheets("list").Cells.Find(what:=varWhat,
LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False)
   If Not rngfound Is Nothing Then
      rngfound.EntireRow.Copy Cells(ActiveCell.Row, 1)
   End If
End Sub

This should do it:

Sub Find_it_and_copy_it()
Dim varWhat
Dim rngFound As Range
Dim R As Long
Dim fFound As Range

varWhat = Application.InputBox("Enter text to find")
Set rngFound = Sheets("list").Cells.Find(what:=varWhat, _
LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False)
Set fFound = rngFound
If Not rngFound Is Nothing Then
Do
R = R + 1
rngFound.EntireRow.Copy Cells(R, 1)
Set rngFound = Sheets("list").Cells.FindNext(after:=rngFound)
Loop Until rngFound.Address = fFound.Address
End If
End Sub

 

[AndreasHermle]

This should do it:

Sub Find_it_and_copy_it()
   Dim varWhat
   Dim rngFound As Range
   Dim R As Long
   Dim fFound As Range

   varWhat = Application.InputBox("Enter text to find")
   Set rngFound = Sheets("list").Cells.Find(what:=varWhat, _
        LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False)
   Set fFound = rngFound
   If Not rngFound Is Nothing Then
      Do
        R = R + 1
        rngFound.EntireRow.Copy Cells(R, 1)
        Set rngFound = Sheets("list").Cells.FindNext(after:=rngFound)
    Loop Until rngFound.Address = fFound.Address
End If
End Sub- Zitierten Text ausblenden -

- Zitierten Text anzeigen -

Hi Per,

thank you very much for your quick support. I am afraid to tell you
that the code keeps writing all the found values right into A1, i.e.
overwriting the values over and over.
Any idea why?

Regards, Andreas

 

[Per Jessen]

Hi Per,

thank you very much for your quick support. I am afraid to tell you
that the code keeps writing all the found values right into A1, i.e.
overwriting the values over and over.
Any idea why?

Regards, Andreas- Skjul tekst i anførselstegn -

- Vis tekst i anførselstegn -

Hi Andreas,

It sounds very strange!

I just tested the code and it pasted each hit to a new row, always
starting from row 1 when I start a new search. Are you sure, that
there is more than one match in the 'List' sheet?

Regards, Per

 

[Gord Dibben]

I also tested Per's code and it worked as advertised.


Gord Dibben MS Excel MVP

 

[AndreasHermle]

I also tested Per's code and it worked as advertised.

Gord Dibben     MS Excel MVP






- Zitierten Text anzeigen -

Dear Gord and Per,

thank you very much for your support. This is really strange. These
are the sample values in the 'list'-sheet:
1754 Martin
1755 Gordon
1756 Jim
1757 Jones

On the other sheet of the same workbook I got a macro button linked to
your code.
Whenever I press it, I am prompted to enter text, I enter either 1754,
1755, 1756 or 1757. In case of entering 1754, the entire row, i.e.
1754 Martin is pasted into the very first row of the active
worksheet.
On running the macro again, I enter 1755 and the entire row, i.e. 1755
Gordon overwrites! the first entry, i.e. 1754 Martin and so forth.

Reading your code it makes absolute sense. I will try it on another
machine and then let you know.

Till then, Regards, Andreas

 

[Gord Dibben]

Don't bother testing that code on another machine.

It was not designed to append results of a new search to the results of earlier
search.

Your original description left out that requirement.

Per and I thought you had duplicate data on sheet "list" and needed multiple
returns from one search.

Try this revised code which does append returns from sequential searches whether
those searches have multiple results or a single result such as you describe in
this post.

Sub Find_it_and_copy_it()
Dim varWhat
Dim rngFound As Range
Dim R As Long
Dim fFound As Range

varWhat = Application.InputBox("Enter text to find")
Set rngFound = Sheets("list").Cells.Find(what:=varWhat, _
LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False)
Set fFound = rngFound
R = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
If R = 1 Then R = R - 1

If Not rngFound Is Nothing Then
Do

R = R + 1
rngFound.EntireRow.Copy Cells(R, 1)
Set rngFound = Sheets("list").Cells.FindNext(after:=rngFound)
Loop Until rngFound.Address = fFound.Address
End If
End Sub


Gord

 

[Gord Dibben]

More than you leaving out the requirement, misinterpretation by Per and myself
of the original description might be the source.

Excel copies the first instance of a found value/data record right
into row 1 of the current worksheet. Subsequent hits should then be
copied into row 2, row 3 etc.

Gord

 

[AndreasHermle]

More than you leaving out the requirement, misinterpretation by Per and myself
of the original description might be the source.


Gord













- Show quoted text -

Gord,

great, thank you very much for the time take and your valuable help.
English being not my mother tongue I am not as good as an english
speaking person in detailing my requirements. And as you told me I
inadvertently left out an important requirement.

Anyhow, the code works just fine, although I had to comment out the
line 'If R = 1 Then R = R - 1. Leaving this line in the code results
in the overwriting of the existing pasted record. Commenting out this
line results in the code working absolutely perfectly, ie it appends
results of a new search to the results of earlier searches.

Again, thank you very much for your professional help. I really
appreciate it.

Regards, Andreas

 

[AndreasHermle]

More than you leaving out the requirement, misinterpretation by Per and myself
of the original description might be the source.


Gord













- Show quoted text -

Hi Gord,

strange, I was just going to acknowledge your question by clicking on
this 5-star rating system. It is gone, how come?

regards, Andreas

 

[Gord Dibben]

Anyhow, the code works just fine, although I had to comment out the

line 'If R = 1 Then R = R - 1. Leaving this line in the code results
in the overwriting of the existing pasted record. Commenting out this
line results in the code working absolutely perfectly, ie it appends
results of a new search to the results of earlier searches.

Not quite perfect. With that line commented out try running the macro on a new
sheet with column A empty.

See that first search return is to A2

My attempt to correct that resulted in the overwrite.

I have revised code again to cover empty column without the overwriting.

Sub Find_it_and_copy_it()
'per jenssen jun 15, 2011
'revised by gord jun 16, 2011
Dim varWhat
Dim rngFound As Range
Dim R As Long
Dim fFound As Range

varWhat = Application.InputBox("Enter text to find")
Set rngFound = Sheets("list").Cells.Find(what:=varWhat, _
LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False)
Set fFound = rngFound
R = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
If R = 1 And Range("A" & R).Value = "" Then
R = R - 1
End If
If Not rngFound Is Nothing Then
Do
R = R + 1
rngFound.EntireRow.Copy Cells(R, 1)
Set rngFound = Sheets("list").Cells.FindNext(after:=rngFound)
Loop Until rngFound.Address = fFound.Address
End If
End Sub


Gord

 

[AndreasHermle]

Not quite perfect.  With that line commented out try running the macro on a new
sheet with column A empty.

See that first search return is to A2

My attempt to correct that resulted in the overwrite.

I have revised code again to cover empty column without the overwriting.

Sub Find_it_and_copy_it()
'per jenssen jun 15, 2011
'revised by gord jun 16, 2011
    Dim varWhat
    Dim rngFound As Range
    Dim R As Long
    Dim fFound As Range

    varWhat = Application.InputBox("Enter text to find")
    Set rngFound = Sheets("list").Cells.Find(what:=varWhat, _
              LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False)
    Set fFound = rngFound
    R = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
    If R = 1 And Range("A" & R).Value = "" Then
        R = R - 1
    End If
    If Not rngFound Is Nothing Then
        Do
            R = R + 1
            rngFound.EntireRow.Copy Cells(R, 1)
            Set rngFound = Sheets("list").Cells.FindNext(after:=rngFound)
        Loop Until rngFound.Address = fFound.Address
    End If
End Sub

Gord




- Zitierten Text anzeigen -

Hi Gord,

great. Now it is really perfect. Works like a charm.
Thank you very much for your great and swift support. This is
professionalism.

Regards, Andreas

 

[Gord Dibben]

Thanks for the feedback.

Happy to assist.


Gord