Excel VBA 2003 create an array and increase search

[Bigger312]

Hi,
I am working in Excel 2003 On a userform I have created a command button "COmpatrol" the code searches for a value of "SA64" on sheet "UnitA" and copies the row its on to a Sheet named "Patrol" .

I am looking for assistance to do expand the code to look for two values "SA64" & "SA69" and widen the search to include the following sheets "UnitA" & "UnitB" & "UnitC" & "UnitD" & "UnitE" all to return the rows that contain the value to sheet "Patrol". Just to clarify the rows in my sheets can have one or both values.

Option Explicit
Private Sub COmpatrol_Click()
Dim C As Range
Dim rngCopyRange As Range
Dim FirstAddress As String
Dim shtSheet1 As Worksheet
Dim shtSheet2 As Worksheet
Dim lngSheet2LastRow As Long
Dim lngSheet2NewRow As Long
Dim LastCopyRow As Integer
Set shtSheet1 = Sheets("UnitA")
Set shtSheet2 = Sheets("Patrol")

lngSheet2LastRow = shtSheet2.Cells(Rows.Count, "A").End(xlUp).Row
lngSheet2NewRow = lngSheet2LastRow + 1

With shtSheet1.Cells
LastCopyRow = 0
Set C = .Find("SA64", _
LookIn:=xlValues, _
Lookat:=xlWhole, _
SearchOrder:=xlByRows)
If Not C Is Nothing Then
FirstAddress = C.Address
Set C = .FindNext(C)
Do
If C.Row <> LastCopyRow Then
C.EntireRow.Copy _
Destination:=shtSheet2.Rows(lngSheet2NewRow)
lngSheet2NewRow = lngSheet2NewRow + 1
LastCopyRow = C.Row
End If
Set C = .FindNext(C)
Loop While Not C Is Nothing And C.Address <> FirstAddress
End If
End With
End Sub

I have been advised to set up an array within this code as follows


CourseArray = Array("SA64","SA69")

for each Course in CourseArray

"enter the code from above except make this one change

Set C = .Find(Course, _
LookIn:=xlValues, _
Lookat:=xlWhole, _
SearchOrder:=xlByRows)

next Course

But i don't have the the experience to do this.

Acknowledgement I have received help to get the code to this stage from Rich & Joel Engineer prior to me finding Eileen's Lounge

Thanks In Advance for your time and help.

[HansV]

Try this version:

Code: Select all

    Dim C As Range
    Dim rngCopyRange As Range
    Dim FirstAddress As String
    Dim shtSheet1 As Worksheet
    Dim shtSheet2 As Worksheet
    Dim lngSheet2LastRow As Long
    Dim lngSheet2NewRow As Long
    Dim LastCopyRow As Integer
    Dim Course As Variant
    Dim CourseArray As Variant

    CourseArray = Array("SA64", "SA69")
    Set shtSheet1 = Sheets("UnitA")
    Set shtSheet2 = Sheets("Patrol")

    lngSheet2LastRow = shtSheet2.Cells(Rows.Count, "A").End(xlUp).Row
    lngSheet2NewRow = lngSheet2LastRow + 1

    For Each Course In CourseArray
        With shtSheet1.Cells
            LastCopyRow = 0
            Set C = .Find(What:=Course, _
                LookIn:=xlValues, _
                Lookat:=xlWhole, _
                SearchOrder:=xlByRows)
            If Not C Is Nothing Then
                FirstAddress = C.Address
                Set C = .FindNext(C)
                Do
                    If C.Row <> LastCopyRow Then
                        C.EntireRow.Copy _
                        Destination:=shtSheet2.Rows(lngSheet2NewRow)
                        lngSheet2NewRow = lngSheet2NewRow + 1
                        LastCopyRow = C.Row
                    End If
                    Set C = .FindNext(C)
                Loop While Not C Is Nothing And C.Address <> FirstAddress
            End If
        End With
    Next Course
End Sub

You skip the first occurence of the search text - is that intentional?

[Bigger312]

Hans,
Does skipping the first occurence of the search text mean skipping the first occurence of SA64 & SA69. I want the array to return all values of SA64 & SA69 where they occur.

Thanks for your help I am going to try new code now.

Gerry

[HansV]

To make the code find all occurrences, change

Code: Select all

            If Not C Is Nothing Then
                FirstAddress = C.Address
                Set C = .FindNext(C)
                Do

to

Code: Select all

            If Not C Is Nothing Then
                FirstAddress = C.Address
                Do

i.e. delete the first occurrence of the line Set C = .FindNext(C).

[HansV]

BTW, the original question plus replies can be found in Excel VBA find string and paste row in the Excel for Developers forum on MSDN.

[Bigger312]

Great Thanks. I will have a look.

Gerry

[Bigger312]

Hans,
It was not my intention to look for a reply to my query from two forums. I wrongly assumed that because I had marked the question as answered in MSDN that Joel would not get my follow up query although I did try. I apologise, my error was not intentional.

Gerry

[HansV]

No problem! You did mention that you had posted the question before.