Home |
Search |
Today's Posts |
#1
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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 returns 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.... I think this line is the problem: If InStr(1, .Value, MyCriteria) 0 Then 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 = rCopyTo.Offset(1, 0) End If End With Next rPointer Application.ScreenUpdating = True MsgBox "Search Completed" End Sub |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
Need formula to return exact match | Excel Worksheet Functions | |||
Vlookup - return exact phrase | Excel Discussion (Misc queries) | |||
Need a function to return EXACT row number of a match | Excel Worksheet Functions | |||
Font color of exact function return in excel should be customize | Excel Programming | |||
Macro to compare values and return exact matching value | Excel Programming |