Listing Using Find and Copy

Option Explicit ' Name of worksheet

Private Const WORKSHEET_NAME = "Find Example" ' Name of range used to flag beginning of ' found list

Private Const FOUND_LIST = "FoundList" ' Name of range that contains the product ' to look for

Private Const LOOK_FOR = "LookFor"

Sub FindExamp1e()

Dim ws As Worksheet Dim rgSearchIn As Range Dim rgFound As Range Dim sFirstFound As String Dim bContinue As Boolean

ResetFoundList

Set ws = ThisWorkbook.Worksheets("Find Example") bContinue = True

Set rgSearchIn = GetSearchRange(ws)

' find the first instance of DLX ' looking at all cells on the worksheet ' looking at the whole contents of the cell Set rgFound = rgSearchIn.Find(ws.Range(LOOK_FOR).Va1ue, _ , xlValues, xlWhole)

' if we found something, remember where we found it

' this is needed to terminate the Do...Loop later on

If Not rgFound Is Nothing Then sFirstFound = rgFound.Address

Do Until rgFound Is Nothing Or Not bContinue CopyItem rgFound

' find the next instance starting with the

' cell after the one we just found

Set rgFound = rgSearchIn.FindNext(rgFound)

' FindNext doesn't automatically stop when it ' reaches the end of the worksheet - rather ' it wraps around to the beginning again. ' we need to prevent an endless loop by stopping ' the process once we find something we've already ' found

If rgFound.Address = sFirstFound Then bContinue = False

Loop

Set rgSearchIn = Nothing Set rgFound = Nothing Set ws = Nothing End Sub

' sets a range reference to the range containing ' the list - the product column

Private Function GetSearchRange(ws As Worksheet) As Range Dim lLastRow As Long lLastRow = ws.Ce11s(65536, 1).End(x1Up).Row Set GetSearchRange = ws.Range(ws.Ce11s(1, 2), _ ws.Ce11s(1LastRow, 2)) End Function

' copies item to found list range Private Sub CopyItem(rgItem As Range) Dim rgDestination As Range Dim rgEntireItem As Range

' need to use a new range object because ' we will be altering this reference. ' altering the reference would screw up ' the find next process in the FindExample ' procedure. also - move off of header row Set rgEntireltem = rgItem.0ffset(0, -1)

' resize reference to consume all four ' columns associated with the found item Set rgEntireltem = rgEntireItem.Resize(1, 4)

' set initial reference to found list

Set rgDestination = rgItem.Parent.Range(F0UND_LIST)

' find first empty row in found list If IsEmpty(rgDestination.0ffset(1, 0)) Then

Set rgDestination = rgDestination.0ffset(1, 0)

Else

Set rgDestination = rgDestination.End(x1Down).0ffset(1, 0) End If

' copy the item to the found list rgEntireItem.Copy rgDestination Set rgDestination = Nothing Set rgEntireItem = Nothing End Sub

' clears contents from the found list range Private Sub ResetFoundList() Dim ws As Worksheet Dim lLastRow As Long Dim rgTopLeft As Range Dim rgBottomRight As Range

Set ws = ThisWorkbook.Worksheets(W0RKSHEET_NAME) Set rgTopLeft = ws.Range(F0UND_LIST).0ffset(1, 0) lLastRow = ws.Range(F0UND_LIST).End(x1Down).Row Set rgBottomRight = _

ws.Ce11s(1LastRow, rgTopLeft.0ffset(0, 3).Co1umn)

ws.Range(rgTopLeft, rgBottomRight).C1earContents

Set rgTopLeft = Nothing

Set rgBottomRight = Nothing

Set ws = Nothing End Sub

This whole process uses four procedures: CopyItem, FindExample, GetSearchRange, and Reset-FoundList. The FindExample procedure is the main procedure; ResetFoundList and GetSearchRange are bit players in this example. Each of these procedures is only called once—though their roles are small they are important. ResetFoundList is called near the beginning of the FindExample procedure to clear any contents from the found list. Like GetSearchRange, the primary task ResetFoundList needs to do is find the bottom of the list.

Notice that all of the procedures and the constants at the top of the listing are declared as private with the exception of the FindExample procedure. Hiding supporting procedures and constants in this manner is a good idea because it prevents the procedures from being called from other modules or from Excel's user interface—although any subroutine that requires a parameter can't be called from the Excel user interface anyway. For me, this practice is as much a mental aid as anything else. It gives me mental closure and helps me visualize the procedures within the module as having a specific purpose. I'm not always the neatest person in the world, but I like some semblance of order, and hiding procedures (by declaring them as private) that aren't meant to be called by external processes creates mental order for me.

The FindExample procedure is typical of many routines that use the Find method. The general approach is to set a reference to a range that represents the range in which you want to search. If you want to search an entire worksheet, you can use the Cells property of the Worksheet object. In this example, you're just looking in the Product column. Because Find returns a range object, you need to declare a Range object variable to hold the result.

The first thing to do is to use the Find method and see if you find anything. If Find doesn't find anything, the range variable holding the result is Nothing. Because Find doesn't automatically stop looking when it hits the beginning or end of the worksheet (depending on which direction you're going), if you find something the first time you call Find, you need to remember the address of what you found. That allows you to make sure that subsequent calls to FindNext don't result in an endless loop of finding the same things over and over again. All you need to do is compare the address of each found cell to the address of the first cell you found.

At this point, you create a loop that keeps calling FindNext. This loop is never entered if the original call to Find doesn't find anything. Inside the loop, you place any statements you want to execute (in this case, you simply call CopyItem), call FindNext, and compare the result's address to the address of the first found item. If the addresses match, a terminating condition is set to exit the loop. One more important comment—the call to FindNext must specify the range from which to start the search. In order to avoid finding the exact same thing over and over again, you need to start searching with the cell after the last cell that was found.

The CopyItem procedure performs a little dance with the item found by the Find and FindNext methods. Because it's important not to "disturb" or change the reference of the rgFound variable lest you create problems with FindNext, you create a range variable named rgEntireItem. You'll use this variable to create a reference to the entire record or item found rather than just the Product field or column held in the rgFound variable. To get a range that represents the entire record, you do two things. First, move over to the first column using Offset and specifying one column to the left. Next, resize the range. Instead of a range that is one row by one column (1 X 1), you need a range that is one row by four columns (1 X 4) because your list is four columns wide.

After all of this, you're nearly ready to copy the record to the found list. The only task left is to figure out exactly where you should copy the record. In this example, I created a named range called

FoundList that is the upper-left cell of the found list. This cell is the column header for the first column of the found list. All you need to do is go to that cell and then find the first empty cell below it and you'll have your destination.

Figure 9.4 shows the results of running the FindExample procedure. The range to search is the current region associated with cell A1 and the product to search for is indicated in cell J1. The found list is the current region associated with cell H4.

0 0

Post a comment