Excel VBA to search for up to 15 values in one search

itemprop="text">

I am trying to run a macro
which allows the user to search up to 15 values in one search. The user may sometimes
only search for 1 value, but the end user wants this option to be available. The code I
have right now searches for one value in Sheet1 & when
found it copies the whole row to Sheet2 which works well. Now I
am trying it for up to 15 values. My current code is below:

Sub FindValues()
 Dim
            LSearchRow As Integer
 Dim rw As Integer, cl As Range, LSearchValue As Long,
            LCopyToRow As Integer

 Sheet2.Cells.Clear

            Sheet1.Select


 On Error GoTo
            Err_Execute

 'this for the end user to input the required A/C to be
            searched

 LSearchValue = InputBox("Please enter a value to search
            for.", "Enter value")
 LCopyToRow = 2

 For rw = 1 To
            1555
 For Each cl In Range("D" & rw & ":M" &
            rw)

 If cl = LSearchValue Then

            cl.EntireRow.Copy
 'Destination:=Worksheets("Sheet2")

            '.Rows(LCopyToRow & ":" & LCopyToRow)

            Sheets("Sheet2").Select
 Rows(LCopyToRow & ":" &
            LCopyToRow).Select
 'Selection.PasteSpecial
            Paste:=xlPasteValuesAndNumberFormats
 Selection.PasteSpecial
            Paste:=xlPasteValuesAndNumberFormats, Operation:= _
 xlNone,
            SkipBlanks:=False, Transpose:=False
 'Move counter to next
            row

 LCopyToRow = LCopyToRow + 1 
 'Go back to Sheet1 to
            continue searching
 Sheets("Sheet1").Select 
 End If

            'LSearchRow = LSearchRow + 1

 Next cl
 Next
            rw

'Position on cell
            A3

'Application.CutCopyMode =
            False
'Selection.Copy

 Sheets("Sheet2").Select

            Cells.Select
 Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone,
            _
 SkipBlanks:=False, Transpose:=False
 Application.CutCopyMode =
            False

 Sheet2.Select




            MsgBox "All matching data has been copied."


 Exit
            Sub

Err_Execute:

 MsgBox "An error
            occurred."


End Sub

Answer

Try the following code. You may want to make
the entry of search terms a little more robust because if they click Cancel, or enter
any non-numeric value, you will get an
error.

Option
            Explicit

Sub FindValues()
Dim LSearchRow As
            Integer

Dim rw As Integer, cl As Range, LSearchValue As Long,
            LCopyToRow As Integer

Dim iHowMany As Integer
Dim
            aSearch(15) As Long
Dim i As Integer

On Error GoTo
            Err_Execute

Sheet2.Cells.Clear
Sheet1.Select



            iHowMany = 0
 LSearchValue = 99

'this for the end user to
            input the required A/C to be searched

 Do While LSearchValue
            <> 0
 LSearchValue = InputBox("Please enter a value to search for. Enter
            a zero to indicate finished entry.", "Enter Search value")
 If LSearchValue
            <> 0 Then
 iHowMany = iHowMany + 1

 If iHowMany
            > 15 Then
 MsgBox "You are limited to 15 search numbers.", vbOKOnly, "Limit
            reached"
 iHowMany = 15
 Exit Do
 End If

            aSearch(iHowMany) = LSearchValue
 End
            If
Loop

If iHowMany = 0 Then

 MsgBox
            "No selections entered.", vbOKOnly + vbCritical, "No Search data"
 Exit
            Sub
End If

LCopyToRow = 2

For rw = 1
            To 1555
 For Each cl In Range("D" & rw & ":M" & rw)

            '------------------------------------------------
 For i = 1 To
            iHowMany

 Debug.Print cl.Row & vbTab & cl.column

            LSearchValue = aSearch(i)
 If cl = LSearchValue Then

            cl.EntireRow.Copy

 'Destination:=Worksheets("Sheet2")

            '.Rows(LCopyToRow & ":" & LCopyToRow)


            Sheets("Sheet2").Select
 Rows(LCopyToRow & ":" &
            LCopyToRow).Select


 'Selection.PasteSpecial
            Paste:=xlPasteValuesAndNumberFormats
 Selection.PasteSpecial
            Paste:=xlPasteValuesAndNumberFormats, Operation:= _
 xlNone,
            SkipBlanks:=False, Transpose:=False

 'Move counter to next
            row
 LCopyToRow = LCopyToRow + 1

 'Go back to Sheet1 to
            continue searching
 Sheets("Sheet1").Select

 End
            If
 Next i
 'LSearchRow = LSearchRow + 1
 Next
            cl
Next rw

'Position on cell
            A3
'Application.CutCopyMode =
            False
'Selection.Copy


Sheets("Sheet2").Select
Cells.Select

Selection.PasteSpecial
            Paste:=xlPasteFormats, Operation:=xlNone, _
 SkipBlanks:=False,
            Transpose:=False

Application.CutCopyMode =
            False
Sheet2.Select

MsgBox "All matching data has been
            copied."


Exit
            Sub

Err_Execute:
MsgBox "An error occurred: " &
            Err.Number & vbTab & Err.Description
Exit Sub
Resume
            Next
End Sub