Hi, I'm having a bit of trouble with this code and would appreciate
some help.

It essentailly is working however when it copies the data to the
"Found" page it always leaves the first row "1" blank and I am fairly
sure it's because of this line:
lRow = wksFound.Cells(Rows.Count, 1).End(xlUp).Row + 1

What I want to do is place the result of my initial search in row 1
then any further search results in row 2, then row 3 etc etc

Hoping someone could offer some assistance.

Kind Regards,
Dean


Public Sub vbaCopyToAnotherSheet()
Dim rCell As Excel.Range
Dim rRow As Excel.Range
Dim wksFound As Excel.Worksheet
Dim wksData As Excel.Worksheet

Dim szLookupVal As String
Dim szRowAddy As String

Dim lRow As Long


Set wksFound = Sheets("Found") 'Sheet that gets the copied data
Set wksData = Sheets("Database") 'Sheet that contains the data to
search


lRow = wksFound.Cells(Rows.Count, 1).End(xlUp).Row + 1

szLookupVal = InputBox("What are you searching for", "Search-Box",
"")
If Len(szLookupVal) = 0 Then Exit Sub

With wksData.Cells

Set rCell = .Find(szLookupVal, , , , , , False)
If Not rCell Is Nothing Then

szRowAddy = rCell.Address

Set rRow = rCell

Do

Set rCell = .FindNext(rCell)

Set rRow = Application.Union(rRow, rCell)

rRow.EntireRow.Copy wksFound.Cells(lRow, 1)

Loop While Not rCell Is Nothing And rCell.Address < szRowAddy

End If
End With

Set rCell = Nothing
Set rRow = Nothing
Set wksFound = Nothing
Set wksData = Nothing
End Sub

If wksFound.Cells(1, 1).Value < "" then
lRow = wksFound.Cells(Rows.Count, 1).End(xlUp).Row + 1
Else
lRow = 1
End if

HTH,
Bernie
MS Excel MVP


"Dean" wrote in message
oups.com...
Hi, I'm having a bit of trouble with this code and would appreciate
some help.

It essentailly is working however when it copies the data to the
"Found" page it always leaves the first row "1" blank and I am fairly
sure it's because of this line:
lRow = wksFound.Cells(Rows.Count, 1).End(xlUp).Row + 1

What I want to do is place the result of my initial search in row 1
then any further search results in row 2, then row 3 etc etc

Hoping someone could offer some assistance.

Kind Regards,
Dean


Public Sub vbaCopyToAnotherSheet()
Dim rCell As Excel.Range
Dim rRow As Excel.Range
Dim wksFound As Excel.Worksheet
Dim wksData As Excel.Worksheet

Dim szLookupVal As String
Dim szRowAddy As String

Dim lRow As Long


Set wksFound = Sheets("Found") 'Sheet that gets the copied data
Set wksData = Sheets("Database") 'Sheet that contains the data to
search


lRow = wksFound.Cells(Rows.Count, 1).End(xlUp).Row + 1

szLookupVal = InputBox("What are you searching for", "Search-Box",
"")
If Len(szLookupVal) = 0 Then Exit Sub

With wksData.Cells

Set rCell = .Find(szLookupVal, , , , , , False)
If Not rCell Is Nothing Then

szRowAddy = rCell.Address

Set rRow = rCell

Do

Set rCell = .FindNext(rCell)

Set rRow = Application.Union(rRow, rCell)

rRow.EntireRow.Copy wksFound.Cells(lRow, 1)

Loop While Not rCell Is Nothing And rCell.Address < szRowAddy

End If
End With

Set rCell = Nothing
Set rRow = Nothing
Set wksFound = Nothing
Set wksData = Nothing
End Sub

lRow = wksFound.Cells(Rows.Count, 1).End(xlUp).Row + 1
If isempty(wksfound.Cells(1,1)) and lRow = 2 then lRow = 1

--
Regards,
Tom Ogilvy



"Dean" wrote:

Hi, I'm having a bit of trouble with this code and would appreciate
some help.

It essentailly is working however when it copies the data to the
"Found" page it always leaves the first row "1" blank and I am fairly
sure it's because of this line:
lRow = wksFound.Cells(Rows.Count, 1).End(xlUp).Row + 1

What I want to do is place the result of my initial search in row 1
then any further search results in row 2, then row 3 etc etc

Hoping someone could offer some assistance.

Kind Regards,
Dean


Public Sub vbaCopyToAnotherSheet()
Dim rCell As Excel.Range
Dim rRow As Excel.Range
Dim wksFound As Excel.Worksheet
Dim wksData As Excel.Worksheet

Dim szLookupVal As String
Dim szRowAddy As String

Dim lRow As Long


Set wksFound = Sheets("Found") 'Sheet that gets the copied data
Set wksData = Sheets("Database") 'Sheet that contains the data to
search


lRow = wksFound.Cells(Rows.Count, 1).End(xlUp).Row + 1

szLookupVal = InputBox("What are you searching for", "Search-Box",
"")
If Len(szLookupVal) = 0 Then Exit Sub

With wksData.Cells

Set rCell = .Find(szLookupVal, , , , , , False)
If Not rCell Is Nothing Then

szRowAddy = rCell.Address

Set rRow = rCell

Do

Set rCell = .FindNext(rCell)

Set rRow = Application.Union(rRow, rCell)

rRow.EntireRow.Copy wksFound.Cells(lRow, 1)

Loop While Not rCell Is Nothing And rCell.Address < szRowAddy

End If
End With

Set rCell = Nothing
Set rRow = Nothing
Set wksFound = Nothing
Set wksData = Nothing
End Sub

Excellent, that did the trick. Thanks again.