LinkBack Thread Tools Search this Thread Display Modes
Prev Previous Post   Next Post Next
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 24
Default Need some advice on the following code

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

 
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
More efficient code advice needed Linking to specific cells in pivot table Excel Programming 2 September 13th 05 10:46 AM
Little more advice on this code Greg B Excel Discussion (Misc queries) 3 September 3rd 05 05:31 AM
Little more advice on this code Greg B[_5_] Excel Programming 3 September 3rd 05 05:31 AM
advice on improving code PC[_3_] Excel Programming 2 April 6th 04 11:37 AM
Code advice please... BruceJ[_2_] Excel Programming 1 November 13th 03 06:44 PM


All times are GMT +1. The time now is 04:06 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"