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

I am not seeing the part where you are trying to account for 15 possible search terms. — Adam
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 " at this point i am trying for one value which is working. im not sure how to change it for 15 values — kay
I hope you are not going to prompt the user 15 times. If so, then save the 15 values (or as many as they enter), counting as they enter them. Then build your loop so that it checks from 1-15 (depending on count), and count how many matches you get. If matches = user inputs, then copy the row. — Wayne G. Dunn
i copy all matches. ie an end user requests account 8188 it copies the whole row and continues searching for 8188 until none is found. So the end user wants to be able to search more than one account. — kay

Wayne G. Dunn Wayne G. Dunn · Accepted Answer · 2014-11-14T23:49:29

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

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

1 Answers