D
Dean
I have listed the code below which allows me to search column "A" for a
value and return those results on another sheet.
I have 5500 rows of data which have numbers in column "A" (lets call
them department codes) from 1 to 30.
The problem I am having as an example is when I search for department
code "7" the code below detects both department "7", "17" and "27"
I would really appreciate some guidance on how to complete the search
but only return results for the numerical value I am searching for.
It's a little beyond my skills....
Thanks,
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 InStr(1, .Value, MyCriteria) > 0 Then
.Resize(, 5).Copy
rCopyTo.PasteSpecial xlPasteValues
' Advance the pointer in your destination table to the
' next available row
Set rCopyTo = rCopyTffset(1, 0)
End If
End With
Next rPointer
Application.ScreenUpdating = True
MsgBox "Search Completed"
End Sub
value and return those results on another sheet.
I have 5500 rows of data which have numbers in column "A" (lets call
them department codes) from 1 to 30.
The problem I am having as an example is when I search for department
code "7" the code below detects both department "7", "17" and "27"
I would really appreciate some guidance on how to complete the search
but only return results for the numerical value I am searching for.
It's a little beyond my skills....
Thanks,
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 InStr(1, .Value, MyCriteria) > 0 Then
.Resize(, 5).Copy
rCopyTo.PasteSpecial xlPasteValues
' Advance the pointer in your destination table to the
' next available row
Set rCopyTo = rCopyTffset(1, 0)
End If
End With
Next rPointer
Application.ScreenUpdating = True
MsgBox "Search Completed"
End Sub