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

Question

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 1

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