1

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
Improve this question
5
  • 1
    I am not seeing the part where you are trying to account for 15 possible search terms. Commented Nov 14, 2014 at 23:10
  • 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 Commented Nov 14, 2014 at 23:13
  • 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. Commented Nov 14, 2014 at 23:17
  • Also, do you copy if ALL match, or if ANY match? Commented Nov 14, 2014 at 23:20
  • 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. Commented Nov 14, 2014 at 23:26

1 Answer 1

Reset to default
3

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
Improve this answer
Sign up to request clarification or add additional context in comments.

Comments

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.