How can I evaluate a number in a column to determine whether or not to copy the data to another sheet

I have a series of data that hinges on one column, an "Entity" column. This entity is simply a number between 1 - 3000 which identifies pieces of equipment. I want to evaluate that number and have VBA copy it to another sheet based on its entity number. Here's what I have:

Sub SplitWOByLines()
    Dim LastRow
    Dim FirstRow
    Dim Cnt
    Set DestSheet = Worksheets("4-3-2011")
    FirstRow = 6
    LastRow = ActiveSheet.UsedRange.Rows.Count
    For Cnt = FirstRow To 10
        If ActiveSheet.Cells(Cnt, 7) = 4034 Then
            ActiveSheet.Cells(Cnt, 3).Select
            Selection.Copy
            ActiveSheet.Paste Destination:=Worksheets("4-3-2011").Cells(Cnt - 3, 2)
            ActiveSheet.Cells(Cnt, 5).Select
            Selection.Copy
            ActiveSheet.Paste Destination:=Worksheets("4-3-2011").Cells(Cnt - 3, 3)
            ActiveSheet.Cells(Cnt, 8).Select
            Selection.Copy
            ActiveSheet.Paste Destination:=Worksheets("4-3-2011").Cells(Cnt - 3, 4)
            ActiveSheet.Cells(Cnt, 10).Select
            Selection.Copy
            ActiveSheet.Paste Destination:=Worksheets("4-3-2011").Cells(Cnt - 3, 5)
            ActiveSheet.Cells(Cnt, 6).Select
            Selection.Copy
            ActiveSheet.Paste Destination:=Worksheets("4-3-2011").Cells(Cnt - 3, 6)
            ActiveSheet.Cells(Cnt, 9).Select
            Selection.Copy
            ActiveSheet.Paste Destination:=Worksheets("4-3-2011").Cells(Cnt - 3, 7)
        End If
    Next Cnt
End Sub

The "4034" is a sample entity number for the data. I only have the loop going through rows 6 through 10 for testing purposes.

How can I get VBA to go through all rows and copy only those that have certain identities? For example, if that cell is equivalent to 4034, 169, 4015, 2525, 195, 318, 1537, etc...there may be 50 for each query. Currently, I can 开发者_Go百科only get it to find one entity at a time.

I don't know of any "If equal to x or y or z or..." statements to do this easily. I thought about a Select/Case, but that would be a lot of repetitive code for copying and pasting, no?

Any help is appreciated.

---

Your basic idea looks fine to me. Just add another loop to cycle through the entity numbers you are interested in, e.g.

Dim myEntities
myEntities = Array(4013, 4503, 57, 1111) ' or whatever

For Cnt = FirstRow To 10
    currentEntity = ActiveSheet.Cells(Cnt, 7)
    For iEntity = LBound(myEntities) To UBound(myEntities)
        If currentEntity  = myEntities(iEntity) Then
            '...
        End If
    Next iEntity
Next Cnt

A couple of important points:

Always avoid Copy/Paste if at all possible! Copy and Paste use the clipboard. Other programs may read from / write to the clipboard while your code is running, which will cause wild, unpredictable results. If you really must use the .Copy method, then use it like this:

ActiveSheet.Cells(Cnt, 3).Copy _
    Destination:=Worksheets("4-3-2011").Cells(Cnt - 3, 2)

Avoid looping through cells as this is super slow. Instead, load a block of cells at once into a Variant array, do your manipulations in VBA (e.g. reordering your values as you do), and then write back to sheet all at once. Doing this will speed up your code by an order of magnitude +.

Dim varSource As Variant
Dim varDestination As Variant
' ...
varSource = rngMySourceRange
' Manipulate data here. Place processed data in varDestination.
rngMyDestinationRange = varDestination

Also, the whole .Select/Selection. jargon is unnecessary and inefficient. That's how Excel machine-generates macros, but a thinking human being really shouldn't reproduce this. Instead of something like:

        ActiveSheet.Cells(Cnt, 3).Select
        Selection.Copy

always write the more succint version, i.e.

        ActiveSheet.Cells(Cnt, 3).Copy

---

Not completely sure I follow, but see if this gives you an idea:

Step 1, build a collection containing the location of each valid entity, with the entity value as a key:

Dim ValidEntities As New Collection
' item #4043 can be found at A5
Call ValidEntities.Add(Range("A5"), "4043")  ' note: keys should be strings
' item #4015 can be found at A6
Call ValidEntities.Add(Range("A6"), "4015")
' etc.

Step 2: rewrite your loop to test for membership in the collection.

' loop over a list of values to check (hardcoded here to check just one)
dim EntityNo as long
dim rgEntity as range

set rgEntity = nothing
on error resume next: set rgEntity = ValidEntities(cstr(EntityNo)): on error goto 0
if rgEntity is nothing
    ' not found - handle error
else
    ' found - rgEntity now points to the range corresp to EntityNo
endif

---

SO, depending on the amount of data you are parsing, this could be a long-running peice of code!

It sounds like you are examining a lot of rows, so you might want to check out MS query instead. However, HERE is some sample code I hacked together. You may have to mess with it, since I don't know from where you are obtaining your criteria values:

'I am passing a collection of values to search for. If the range of values you are searching
'for exists as a RANGE of values within a spreadsheet, you can change the collection param
'to a range object instead.
Public Sub SplitWOBByLines(ByVal DestSheet As Worksheet, ByVal FindItems As Collection)
    Dim SourceSheet As Worksheet
    Dim ColumnRange As Range
    Dim RowRange As Range
    Dim SearchRange As Range
    Dim EntityCell As Range

    'You COULD pass this in as a param as well
    Set SourceSheet = ActiveSheet

    'Find the columns used in the Source worksheet:
    Set ColumnRange = SourceSheet.UsedRange.Columns

    'Find the Rows used in the source worksheet:
    Set RowRange = SourceSheet.UsedRange.Rows

    'The Search area is the intersection of the two:
    Set SearchRange = Intersect(ColumnRange, RowRange)

    'An iteration variable for For . . .Next loop:
    Dim CurrentItem As Variant

    'An iteration variable for the inner For . . .Next loop:
    Dim CurrentRow As Range

    'A placeholder variable for the output row index:
    Dim DestinationRowIndex As Integer

    'Find the area of the destination sheet already used (If sheet is empty, this will be 1):
    DestinationRowIndex = DestSheet.UsedRange.Rows.Count

    If DestinationRowIndex > 1 Then
        'Data already exists. Start at the row AFTER the last used row:
        DestinationRowIndex = DestinationRowIndex + 1
    End If

    'Outer loop iterates through the items you are Searching for:
    For Each CurrentItem In FindItems

        'Inner loop iterates through the rows in the Source sheet
        'which contain data:
        For Each CurrentRow In SearchRange.Rows
            If CurrentRow.Cells(, 7) = CurrentItem Then
                CurrentRow.Copy
                SourceSheet.Paste DestSheet.Cells(DestinationRowIndex, 1)
                DestinationRowIndex = DestinationRowIndex + 1
           End If
        Next
    Next

End Sub

'I used the WorkSheet_SelectionChange Event to trigger a test, using some random
'data I placed in the source sheet, and some arbitrary values added to the collection:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    Dim DestSheet As Worksheet
    Set DestSheet = Worksheets("4-3-2011")
    Dim colFindItems As Collection

    Set colFindItems = New Collection
    colFindItems.Add 20
    colFindItems.Add 40

    Call Me.SplitWOBByLines(DestSheet, colFindItems)

End Sub