Shaolin1976
05-06-2006, 03:24 AM
Hi,
Firstly, many thanks to Tecnik for the helpful links in http://vbaexpress.com/forum/showthread.php?t=7910
I have been trying to modify a macro found on one of Tecnik's links which searches a column in the activesheet and copies the results to an different sheet.
I have a search sheet (imaginatively named "SEARCH") and numerous other sheets (named 1 through to 100) which contain the data which is to be searched. I would like to have the macro (located on a button in the "SEARCH" sheet) search column A in all other sheets and paste each row where it finds a match into the SEARCH sheet.
I have been trying to get this to work for just one sheet (Sheet 88) to start with and then go from there to make it search all sheets but I keep geting an error on Line 20 and I really haven't a clue as to why. Any help as to why the error keeps occuring and also how I'd go about making it search all other sheets in the workbook would be greatly appreciated. Ideally I would like to have an input box from which I can enter the value to be searched but thats only if the following code works without throwing up an error first!
Public Sub SearchButton_Click()
Dim LSearchRow As Integer
Dim LCopyToRow As Integer
On Error GoTo Err_Execute
'Start search in row 2
LSearchRow = 2
'Start copying data to row 2 in SEARCH (row counter variable)
LCopyToRow = 2
While Len(Sheets("88").Range("A" & CStr(LSearchRow)).Value) > 0
'If value in column A = "Test", copy entire row to SEARCH
If Sheets("88").Range("A" & CStr(LSearchRow)).Value = "Test" Then
'Select row in Sheet 88 to copy
Sheets(88).Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
Selection.Copy
'Paste row into SEARCH in next row
Sheets("SEARCH").Select
Sheets("SEARCH").Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
ActiveSheet.Paste
'Move counter to next row
LCopyToRow = LCopyToRow + 1
'Go back to Sheet 88 to continue searching
Sheets("88").Select
End If
LSearchRow = LSearchRow + 1
Wend
'Position on cell A3
Application.CutCopyMode = False
Sheets("SEARCH").Range("A3").Select
MsgBox "All matching data has been copied."
Exit Sub
Err_Execute:
MsgBox "An error occurred."
End SubMany thanks
Shaolin
Firstly, many thanks to Tecnik for the helpful links in http://vbaexpress.com/forum/showthread.php?t=7910
I have been trying to modify a macro found on one of Tecnik's links which searches a column in the activesheet and copies the results to an different sheet.
I have a search sheet (imaginatively named "SEARCH") and numerous other sheets (named 1 through to 100) which contain the data which is to be searched. I would like to have the macro (located on a button in the "SEARCH" sheet) search column A in all other sheets and paste each row where it finds a match into the SEARCH sheet.
I have been trying to get this to work for just one sheet (Sheet 88) to start with and then go from there to make it search all sheets but I keep geting an error on Line 20 and I really haven't a clue as to why. Any help as to why the error keeps occuring and also how I'd go about making it search all other sheets in the workbook would be greatly appreciated. Ideally I would like to have an input box from which I can enter the value to be searched but thats only if the following code works without throwing up an error first!
Public Sub SearchButton_Click()
Dim LSearchRow As Integer
Dim LCopyToRow As Integer
On Error GoTo Err_Execute
'Start search in row 2
LSearchRow = 2
'Start copying data to row 2 in SEARCH (row counter variable)
LCopyToRow = 2
While Len(Sheets("88").Range("A" & CStr(LSearchRow)).Value) > 0
'If value in column A = "Test", copy entire row to SEARCH
If Sheets("88").Range("A" & CStr(LSearchRow)).Value = "Test" Then
'Select row in Sheet 88 to copy
Sheets(88).Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
Selection.Copy
'Paste row into SEARCH in next row
Sheets("SEARCH").Select
Sheets("SEARCH").Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
ActiveSheet.Paste
'Move counter to next row
LCopyToRow = LCopyToRow + 1
'Go back to Sheet 88 to continue searching
Sheets("88").Select
End If
LSearchRow = LSearchRow + 1
Wend
'Position on cell A3
Application.CutCopyMode = False
Sheets("SEARCH").Range("A3").Select
MsgBox "All matching data has been copied."
Exit Sub
Err_Execute:
MsgBox "An error occurred."
End SubMany thanks
Shaolin