I am having some problems getting the code below to work.

I have a few thousand rows of numbers listed in Column A with a number
range from 1 to 30. These numbers are spread randomly down the column.

What I am trying to do is search column A for specific instances of
each number eg 7 and then the code will copy an past those rows
containing "7" to a sheet labelled "found"

Would appreciate any mods or changes inorder to get this code working.

Kind Regards,
Dean

Sub Macro2()

Dim LastRow As Long, MyCriteria, _
rCriteriaField As Range, rPointer As Range, rCopyTo As Range

' This variable has the value of the criteria by which you intend
' to select records to extract. Lets assume you are evaluating
' the entries in column A of your source table. This can be either
' text or numeric.
Application.ScreenUpdating = False
MyCriteria = InputBox("Enter Dept Code")
If MyCriteria = "" Then Exit Sub

' Initialize a variable for the last possible record in a worksheet
If Left(Application.Version, 1) < 8 Then _
LastRow = 5570 Else LastRow = 65536

With ThisWorkbook

' Initialize a range object variable for the entire populated
' area of column B (excluding row 1 for a header)
With Worksheets("database")
Set rCriteriaField = .Range(.Cells(1, 1), _
.Cells(Application.Max(1, _
.Cells(LastRow, 1).End(xlUp).Row), 1))
End With

' Initialize a range object variable to serve as a pointer
' for the records in sheet 2
Set rCopyTo = .Worksheets("found").Cells(1, 1)
End With

' Loop through all the records in your source data table
For Each rPointer In rCriteriaField
With rPointer

' If there is a match on the criteria in col A then copy
' the record to the destination table
If .Value = MyCriteria then
.Resize(, 5).Copy
rCopyTo.PasteSpecial xlPasteValues

' Advance the pointer in your destination table to the
' next available row
Set rCopyTo = rCopyTo.Offset(1, 0)
End If
End With
Next rPointer
Application.ScreenUpdating = True
MsgBox "Search Completed"
End Sub

Sub Macro2()
Dim LastRow As Long, MyCriteria, _
rng As Range

Application.ScreenUpdating = False
MyCriteria = InputBox("Enter Dept Code")
If MyCriteria = "" Then Exit Sub

LastRow = ActiveSheet.Rows.Count

With ThisWorkbook.Worksheets("database")

.Range("A1").EntireRow.Insert
.Range("A1").Value = "Temp"
Set rng = .Range("A2").Resize(.Cells(.Rows.Count,
"A").End(xlUp).Row - 1)
.Columns("A:A").AutoFilter Field:=1, Criteria1:=MyCriteria

rng.SpecialCells(xlCellTypeVisible).EntireRow.Copy _
ThisWorkbook.Worksheets("found").Cells(1, 1)

.Rows(1).Delete

End With

Application.ScreenUpdating = True
MsgBox "Search Completed"

End Sub

--

HTH

Bob Phillips

(remove nothere from the email address if mailing direct)

"Dean" wrote in message
oups.com...
I am having some problems getting the code below to work.

I have a few thousand rows of numbers listed in Column A with a number
range from 1 to 30. These numbers are spread randomly down the column.

What I am trying to do is search column A for specific instances of
each number eg 7 and then the code will copy an past those rows
containing "7" to a sheet labelled "found"

Would appreciate any mods or changes inorder to get this code working.

Kind Regards,
Dean

Sub Macro2()

Dim LastRow As Long, MyCriteria, _
rCriteriaField As Range, rPointer As Range, rCopyTo As Range

' This variable has the value of the criteria by which you intend
' to select records to extract. Lets assume you are evaluating
' the entries in column A of your source table. This can be either
' text or numeric.
Application.ScreenUpdating = False
MyCriteria = InputBox("Enter Dept Code")
If MyCriteria = "" Then Exit Sub

' Initialize a variable for the last possible record in a worksheet
If Left(Application.Version, 1) < 8 Then _
LastRow = 5570 Else LastRow = 65536

With ThisWorkbook

' Initialize a range object variable for the entire populated
' area of column B (excluding row 1 for a header)
With Worksheets("database")
Set rCriteriaField = .Range(.Cells(1, 1), _
.Cells(Application.Max(1, _
.Cells(LastRow, 1).End(xlUp).Row), 1))
End With

' Initialize a range object variable to serve as a pointer
' for the records in sheet 2
Set rCopyTo = .Worksheets("found").Cells(1, 1)
End With

' Loop through all the records in your source data table
For Each rPointer In rCriteriaField
With rPointer

' If there is a match on the criteria in col A then copy
' the record to the destination table
If .Value = MyCriteria then
.Resize(, 5).Copy
rCopyTo.PasteSpecial xlPasteValues

' Advance the pointer in your destination table to the
' next available row
Set rCopyTo = rCopyTo.Offset(1, 0)
End If
End With
Next rPointer
Application.ScreenUpdating = True
MsgBox "Search Completed"
End Sub

This should be close...

Sub CopyRows()
Dim wksToSearch As Worksheet
Dim rngToSearch As Range
Dim rngFound As Range
Dim rngFoundAll As Range
Dim strFirst As String


Set wksToSearch = ActiveSheet
Set rngToSearch = wksToSearch.Columns("A")
Set rngFound = rngToSearch.Find(What:=7, _
LookAt:=xlWhole, _
LookIn:=xlValues)
If Not rngFound Is Nothing Then
Set rngFoundAll = rngFound
strFirst = rngFound.Address
Do
Set rngFoundAll = Union(rngFound, rngFoundAll)
Set rngFound = rngToSearch.FindNext(rngFound)
Loop Until rngFound.Address = strFirst
rngFoundAll.EntireRow.Copy Sheets("Found").Range("A2")
'rngFoundAll.EntireRow.Copy
'Sheets("Found").Range("A2").PasteSpecial(xlValues )
'Application.cutcopymode = false
End If
End Sub

It does a standard paste, not a paste special. If you need paste special
then uncomment those lines...
--
HTH...

Jim Thomlinson


"Dean" wrote:

I am having some problems getting the code below to work.

I have a few thousand rows of numbers listed in Column A with a number
range from 1 to 30. These numbers are spread randomly down the column.

What I am trying to do is search column A for specific instances of
each number eg 7 and then the code will copy an past those rows
containing "7" to a sheet labelled "found"

Would appreciate any mods or changes inorder to get this code working.

Kind Regards,
Dean

Sub Macro2()

Dim LastRow As Long, MyCriteria, _
rCriteriaField As Range, rPointer As Range, rCopyTo As Range

' This variable has the value of the criteria by which you intend
' to select records to extract. Lets assume you are evaluating
' the entries in column A of your source table. This can be either
' text or numeric.
Application.ScreenUpdating = False
MyCriteria = InputBox("Enter Dept Code")
If MyCriteria = "" Then Exit Sub

' Initialize a variable for the last possible record in a worksheet
If Left(Application.Version, 1) < 8 Then _
LastRow = 5570 Else LastRow = 65536

With ThisWorkbook

' Initialize a range object variable for the entire populated
' area of column B (excluding row 1 for a header)
With Worksheets("database")
Set rCriteriaField = .Range(.Cells(1, 1), _
.Cells(Application.Max(1, _
.Cells(LastRow, 1).End(xlUp).Row), 1))
End With

' Initialize a range object variable to serve as a pointer
' for the records in sheet 2
Set rCopyTo = .Worksheets("found").Cells(1, 1)
End With

' Loop through all the records in your source data table
For Each rPointer In rCriteriaField
With rPointer

' If there is a match on the criteria in col A then copy
' the record to the destination table
If .Value = MyCriteria then
.Resize(, 5).Copy
rCopyTo.PasteSpecial xlPasteValues

' Advance the pointer in your destination table to the
' next available row
Set rCopyTo = rCopyTo.Offset(1, 0)
End If
End With
Next rPointer
Application.ScreenUpdating = True
MsgBox "Search Completed"
End Sub

Good morning

How about these few lines?

Selection.AutoFilter
Selection.AutoFilter Field:=1, Criteria1:="9"
Cells.SpecialCells(xlCellTypeVisible).Copy Sheets(2).Range("A1")

Regards

"Dean" wrote:

I am having some problems getting the code below to work.

I have a few thousand rows of numbers listed in Column A with a number
range from 1 to 30. These numbers are spread randomly down the column.

What I am trying to do is search column A for specific instances of
each number eg 7 and then the code will copy an past those rows
containing "7" to a sheet labelled "found"

Would appreciate any mods or changes inorder to get this code working.

Kind Regards,
Dean

Sub Macro2()

Dim LastRow As Long, MyCriteria, _
rCriteriaField As Range, rPointer As Range, rCopyTo As Range

' This variable has the value of the criteria by which you intend
' to select records to extract. Lets assume you are evaluating
' the entries in column A of your source table. This can be either
' text or numeric.
Application.ScreenUpdating = False
MyCriteria = InputBox("Enter Dept Code")
If MyCriteria = "" Then Exit Sub

' Initialize a variable for the last possible record in a worksheet
If Left(Application.Version, 1) < 8 Then _
LastRow = 5570 Else LastRow = 65536

With ThisWorkbook

' Initialize a range object variable for the entire populated
' area of column B (excluding row 1 for a header)
With Worksheets("database")
Set rCriteriaField = .Range(.Cells(1, 1), _
.Cells(Application.Max(1, _
.Cells(LastRow, 1).End(xlUp).Row), 1))
End With

' Initialize a range object variable to serve as a pointer
' for the records in sheet 2
Set rCopyTo = .Worksheets("found").Cells(1, 1)
End With

' Loop through all the records in your source data table
For Each rPointer In rCriteriaField
With rPointer

' If there is a match on the criteria in col A then copy
' the record to the destination table
If .Value = MyCriteria then
.Resize(, 5).Copy
rCopyTo.PasteSpecial xlPasteValues

' Advance the pointer in your destination table to the
' next available row
Set rCopyTo = rCopyTo.Offset(1, 0)
End If
End With
Next rPointer
Application.ScreenUpdating = True
MsgBox "Search Completed"
End Sub