How to create a loop for below code?

Excel vba code

• QUESTION: In need of vba code to search an entire workbook from user input for a variable and then copy and paste the row that the variable is found to another worksheet. ANSWER: Lynne It shouldn't be too hard to do that. A little more information will be helpful: Is the variable something that matches a cell value or a partial match of the cell value? Are searching all the worksheets in the workbook, except the one to which you are writing the row that contains the searched for variable? Will you be adding to the list of found stuff or creating a new list whenever the code is run? ---------- FOLLOW-UP ---------- QUESTION: ANSWER: Lynne The following code will go through each worksheet in the active workbook. If the worksheet name is NOT "summary" it will search for the"test". If "test" is in any cell in the used range of the worksheet, the entire row will be copied and pasted to the worksheet name "summary", starting in row 2. Sub SearchWorkbook() Dim wksht As Worksheet Dim c As Range Dim firstaddress As String Dim i As Integer i = 2 For Each wksht In Sheets wksht.Activate If Not ActiveSheet.Name = "summary" Then With ActiveSheet.UsedRange Set c = .Find(What:="test", _ After:=ActiveCell, _ LookIn:=xlFormulas, _ LookAt:=xlPart, _ SearchOrder:=xlByRows, _ SearchDirection:=xlNext, _ MatchCase:=False) If Not c Is Nothing Then firstaddress = c.Address Do c.EntireRow.Copy Sheets("summary").Activate Cells(i, 1).Activate ActiveSheet.Paste i = i + 1 wksht.Activate Set c = .FindNext(c) Loop While Not c Is Nothing _ And c.Address <> firstaddress End If End With End If Next wksht End Sub ---------- FOLLOW-UP ---------- QUESTION: Thanks so much Ken, It start the process of checking all the worksheets great. I don't know if it copies and paste the rows I need because I get the error mismatch type #13. I probably should have asked for an input box for the variable and also noted that the variable is text not numeric. I tried researching this error message, but must confess that I don't know how to correct that. And lastly, the routine can stop checking after say row 200. Sorry to have to have redoing things, but I never done this process before. Hi Jan, I currently have anVBA code setup in Microsoft Access that is able to create individualfiles based on the information stored in the Query's tab of Access. However im have trouble running the VBA code. The issue is everytime the VBA code is 'turned on' it is giving me an error message of "Item not found in this collection". I've been trying to figure it out for a long period, however with no results. Hope you can help me wih it. The VBA code is at the bot---X--- Option Compare Database Private Sub Command1_Click() On Error GoTo Err_Command1_Click Dim stQueryName As String Dim stDocName As String Set db = CurrentDb() Set rst = db.OpenRecordset("Table1") rst.MoveFirst Do Until rst.EOF stQueryName = "xls_stores_POG" stDocName = rst!Count DoCmd.OpenQuery (stQueryName) DoCmd.ApplyFilter , "Store_No = " & rst!Count DoCmd.OutputTo acOutputQuery, stQueryName, acFormatXLS, "C:\SET\" & CStr(stDocName) & ".xls" DoCmd.Close acQuery, stQueryName, acSaveNo rst.MoveNext Loop Exit_Command1_Click: Exit Sub Err_Command1_Click: MsgBox Err.Description Resume Exit_Command1_Click End Sub

• Answer:

  Lynne This seems to work for me. I added the InputBox and tested it for numeric and nonnumeric values and values that were not to be found on the worksheets. I added the calculate line at the end because it seemed like it need to be slowed down or sometimes it go hung up on the same row of data and copied it a million times. Sub SearchWorkbook() Dim wksht As Worksheet Dim c As Range Dim firstaddress As String Dim i As Integer Dim w As Variant i = 2 w = InputBox("What are you looking for?") For Each wksht In Sheets wksht.Activate Cells(1, 1).Activate If Not ActiveSheet.Name = "summary" Then With ActiveSheet.UsedRange Set c = .Find(What:=w, _ After:=ActiveCell, _ LookIn:=xlFormulas, _ LookAt:=xlPart, _ SearchOrder:=xlByRows, _ SearchDirection:=xlNext, _ MatchCase:=False) If Not c Is Nothing Then firstaddress = c.Address Do c.EntireRow.Copy Sheets("summary").Activate Cells(i, 1).Activate ActiveSheet.Paste i = i + 1 wksht.Activate Set c = .FindNext(c) Loop While Not c Is Nothing _ And c.Address <> firstaddress End If End With End If Calculate Next wksht End Sub Sorry for the melated reply, I was to busy... M Dim stQueryName As String Dim stDocName As String Set db = CurrentDb() Set rst = db.OpenRecordset("Table1") rst.MoveFirst stQueryName = "xls_stores_POG" 'Do not open the query within the loop, very inefficient DoCmd.OpenQuery (stQueryName) Do Until rst.EOF stDocName = rst!Count DoCmd.ApplyFilter , "Store_No = " & stDocName DoCmd.OutputTo acOutputQuery, stQueryName, acFormatXLS, "C:\SET\" & CStr(stDocName) & ".xls" rst.MoveNext Loop DoCmd.Close acQuery, stQueryName, acSaveNo Exit_Command1_Click: Exit Sub Err_Command1_Click: MsgBox Err.Description Resume Exit_Command1_Click End Sub