D
Dean
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
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