If this is your first visit, be sure to check out the FAQ by clicking the link above. You may have to register before you can post: click the register link above to proceed. To start viewing messages, select the forum that you want to visit from the selection below. |
|
|
Thread Tools | Display Modes |
#1
|
|||
|
|||
Find Cut and paste
Hi,
I have a large amount of data containing unique codes. I want to type in a list of codes and the program to find them in worksheet 1 Cut and paste it into worksheet 2. I can set up a macro to do the cut and paste but its long winded entering each code into the find box then waiting while the code is found then cut and paste using a macro. Any ideas on how i can speed it up please? |
#2
|
|||
|
|||
Find Cut and paste
If desired, send your file to my address below. I will only look if:
1. You send a copy of this message on an inserted sheet 2. You give me the newsgroup and the subject line 3. You send a clear explanation of what you want 4. You send before/after examples and expected results. Also show your efforts to date -- Don Guillett Microsoft MVP Excel SalesAid Software "kingie" wrote in message ... Hi, I have a large amount of data containing unique codes. I want to type in a list of codes and the program to find them in worksheet 1 Cut and paste it into worksheet 2. I can set up a macro to do the cut and paste but its long winded entering each code into the find box then waiting while the code is found then cut and paste using a macro. Any ideas on how i can speed it up please? |
#3
|
|||
|
|||
Find Cut and paste
I have two solutions for you, the first code module will do the find with a
COPY and paste. The second one does the equivalent of an actual CUT and paste. I wrote them since I wasn't sure if you really wanted cut and paste or just copy and paste. You'll need to change the values of various Const value declarations in them for them to work in your setup. To put the code to work, decide on which one you want to use, then open your workbook and press [Alt]+[F11] to open the Visual Basic editor and then choose Insert -- Module to open a new code module. Then copy the code segment you want to use and paste it into the code module, make required changes and close the VB editor. To use the code you'll need a sheet added to the workbook to put a list of codes to find into. That is all dealt with in this section of the code: Const reportSheetName = "FoundSheet" Const reportColumn = "A" Dim reportSheet As Worksheet So you need a sheet named FoundSheet added to the workbook, and you'll type the entries to be found into column A of it. Once you do that, you use Tools -- Macro -- Macros to select the macro you copied and [Run] it. Here's the find, COPY and paste code: Sub FindAndCopy() 'these all deal with the list to be searched 'it allows the search column to be in the 'middle of a group of columns that are to 'be copied when a match is found 'change the Const value(s) as needed. Const sourceListSheetName = "SourceListSheet" 'id of column with list to be searched Const searchColumn = "A" ' change if needed 'id of first column to be copied Const firstColumn = "A" ' change if needed 'id of last column to be copied Const lastColumn = "C" ' change if needed Dim sourceList As Range Dim anySourceEntry As Range 'these deal with the list of entries that 'are to be found in the sourceList 'change the Const value(s) as needed. Const findListSheetName = "SearchForListSheet" Const findListColumn = "A" Dim findList As Range Dim foundItem As Range Dim anyFindEntry As Range 'these deal with the sheet where the results 'of the search operations will be reported/copied to 'change the Const value(s) as needed. Const reportSheetName = "FoundSheet" Const reportColumn = "A" Dim reportSheet As Worksheet 'used to copy from source list to the report sheet Dim cellsToCopy As Range 'set up reference to the list to be searched Set sourceList = ThisWorkbook.Worksheets(sourceListSheetName) _ .Range(searchColumn & "1:" & _ ThisWorkbook.Worksheets(sourceListSheetName) _ .Range(searchColumn & Rows.Count).End(xlUp).Address) 'set up reference to the list of entries to find Set findList = ThisWorkbook.Worksheets(findListSheetName) _ .Range(findListColumn & "1:" & _ ThisWorkbook.Worksheets(findListSheetName) _ .Range(findListColumn & Rows.Count).End(xlUp).Address) 'set up reference to the results reporting sheet Set reportSheet = ThisWorkbook.Worksheets(reportSheetName) 'clear any earlier results from the results sheet reportSheet.Cells.ClearContents 'begin the searching For Each anyFindEntry In findList If Not IsEmpty(anyFindEntry) Then Set foundItem = sourceList.Find(What:=anyFindEntry, _ LookIn:=xlFormulas, LookAt:=xlPart, _ SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, SearchFormat:=False) If Not foundItem Is Nothing Then 'found a match Set cellsToCopy = _ ThisWorkbook.Worksheets(sourceListSheetName) _ .Range(firstColumn & foundItem.Row & ":" & _ lastColumn & foundItem.Row) cellsToCopy.Copy reportSheet.Range(reportColumn & Rows.Count) _ .End(xlUp).Offset(1, 0).PasteSpecial _ Paste:=xlPasteValues End If End If Next ' 'housekeeping Set reportSheet = Nothing Set findList = Nothing Set sourceList = Nothing Set cellsToCopy = Nothing End Sub and here is the find, CUT and paste code: Sub FindCopyAndDelete() 'effectively the same as cut and paste ' 'these all deal with the list to be searched 'it allows the search column to be in the 'middle of a group of columns that are to 'be copied when a match is found 'change the Const value(s) as needed. Const sourceListSheetName = "SourceListSheet" 'id of column with list to be searched Const searchColumn = "A" ' change if needed 'id of first column to be copied Const firstColumn = "A" ' change if needed 'id of last column to be copied Const lastColumn = "C" ' change if needed Dim sourceList As Range Dim anySourceEntry As Range 'these deal with the list of entries that 'are to be found in the sourceList 'change the Const value(s) as needed. Const findListSheetName = "SearchForListSheet" Const findListColumn = "A" Dim findList As Range Dim foundItem As Range Dim anyFindEntry As Range 'these deal with the sheet where the results 'of the search operations will be reported/copied to 'change the Const value(s) as needed. Const reportSheetName = "FoundSheet" Const reportColumn = "A" Dim reportSheet As Worksheet 'used to copy from source list to the report sheet Dim cellsToCopy As Range 'set up reference to the list to be searched Set sourceList = ThisWorkbook.Worksheets(sourceListSheetName) _ .Range(searchColumn & "1:" & _ ThisWorkbook.Worksheets(sourceListSheetName) _ .Range(searchColumn & Rows.Count).End(xlUp).Address) 'set up reference to the list of entries to find Set findList = ThisWorkbook.Worksheets(findListSheetName) _ .Range(findListColumn & "1:" & _ ThisWorkbook.Worksheets(findListSheetName) _ .Range(findListColumn & Rows.Count).End(xlUp).Address) 'set up reference to the results reporting sheet Set reportSheet = ThisWorkbook.Worksheets(reportSheetName) 'clear any earlier results from the results sheet reportSheet.Cells.Clear ' clear contents and formatting 'begin the searching For Each anyFindEntry In findList If Not IsEmpty(anyFindEntry) Then Set foundItem = sourceList.Find(What:=anyFindEntry, _ LookIn:=xlFormulas, LookAt:=xlPart, _ SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, SearchFormat:=False) If Not foundItem Is Nothing Then 'found a match Set cellsToCopy = _ ThisWorkbook.Worksheets(sourceListSheetName) _ .Range(firstColumn & foundItem.Row & ":" & _ lastColumn & foundItem.Row) cellsToCopy.Copy reportSheet.Range(reportColumn & Rows.Count) _ .End(xlUp).Offset(1, 0).PasteSpecial _ Paste:=xlPasteAll cellsToCopy.ClearContents End If End If Next Application.CutCopyMode = False ' 'housekeeping Set reportSheet = Nothing Set findList = Nothing Set sourceList = Nothing Set cellsToCopy = Nothing End Sub "kingie" wrote: Hi, I have a large amount of data containing unique codes. I want to type in a list of codes and the program to find them in worksheet 1 Cut and paste it into worksheet 2. I can set up a macro to do the cut and paste but its long winded entering each code into the find box then waiting while the code is found then cut and paste using a macro. Any ideas on how i can speed it up please? |
#4
|
|||
|
|||
Find Cut and paste
Hi JLatham
Thanks for the reply you have there's a lot of work gone into it and i appreciate the time you have taken to give me an answer. I am currently trying to put the correct references into the code to make it work. Thanks again Charlie "JLatham" wrote: I have two solutions for you, the first code module will do the find with a COPY and paste. The second one does the equivalent of an actual CUT and paste. I wrote them since I wasn't sure if you really wanted cut and paste or just copy and paste. You'll need to change the values of various Const value declarations in them for them to work in your setup. To put the code to work, decide on which one you want to use, then open your workbook and press [Alt]+[F11] to open the Visual Basic editor and then choose Insert -- Module to open a new code module. Then copy the code segment you want to use and paste it into the code module, make required changes and close the VB editor. To use the code you'll need a sheet added to the workbook to put a list of codes to find into. That is all dealt with in this section of the code: Const reportSheetName = "FoundSheet" Const reportColumn = "A" Dim reportSheet As Worksheet So you need a sheet named FoundSheet added to the workbook, and you'll type the entries to be found into column A of it. Once you do that, you use Tools -- Macro -- Macros to select the macro you copied and [Run] it. Here's the find, COPY and paste code: Sub FindAndCopy() 'these all deal with the list to be searched 'it allows the search column to be in the 'middle of a group of columns that are to 'be copied when a match is found 'change the Const value(s) as needed. Const sourceListSheetName = "SourceListSheet" 'id of column with list to be searched Const searchColumn = "A" ' change if needed 'id of first column to be copied Const firstColumn = "A" ' change if needed 'id of last column to be copied Const lastColumn = "C" ' change if needed Dim sourceList As Range Dim anySourceEntry As Range 'these deal with the list of entries that 'are to be found in the sourceList 'change the Const value(s) as needed. Const findListSheetName = "SearchForListSheet" Const findListColumn = "A" Dim findList As Range Dim foundItem As Range Dim anyFindEntry As Range 'these deal with the sheet where the results 'of the search operations will be reported/copied to 'change the Const value(s) as needed. Const reportSheetName = "FoundSheet" Const reportColumn = "A" Dim reportSheet As Worksheet 'used to copy from source list to the report sheet Dim cellsToCopy As Range 'set up reference to the list to be searched Set sourceList = ThisWorkbook.Worksheets(sourceListSheetName) _ .Range(searchColumn & "1:" & _ ThisWorkbook.Worksheets(sourceListSheetName) _ .Range(searchColumn & Rows.Count).End(xlUp).Address) 'set up reference to the list of entries to find Set findList = ThisWorkbook.Worksheets(findListSheetName) _ .Range(findListColumn & "1:" & _ ThisWorkbook.Worksheets(findListSheetName) _ .Range(findListColumn & Rows.Count).End(xlUp).Address) 'set up reference to the results reporting sheet Set reportSheet = ThisWorkbook.Worksheets(reportSheetName) 'clear any earlier results from the results sheet reportSheet.Cells.ClearContents 'begin the searching For Each anyFindEntry In findList If Not IsEmpty(anyFindEntry) Then Set foundItem = sourceList.Find(What:=anyFindEntry, _ LookIn:=xlFormulas, LookAt:=xlPart, _ SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, SearchFormat:=False) If Not foundItem Is Nothing Then 'found a match Set cellsToCopy = _ ThisWorkbook.Worksheets(sourceListSheetName) _ .Range(firstColumn & foundItem.Row & ":" & _ lastColumn & foundItem.Row) cellsToCopy.Copy reportSheet.Range(reportColumn & Rows.Count) _ .End(xlUp).Offset(1, 0).PasteSpecial _ Paste:=xlPasteValues End If End If Next ' 'housekeeping Set reportSheet = Nothing Set findList = Nothing Set sourceList = Nothing Set cellsToCopy = Nothing End Sub and here is the find, CUT and paste code: Sub FindCopyAndDelete() 'effectively the same as cut and paste ' 'these all deal with the list to be searched 'it allows the search column to be in the 'middle of a group of columns that are to 'be copied when a match is found 'change the Const value(s) as needed. Const sourceListSheetName = "SourceListSheet" 'id of column with list to be searched Const searchColumn = "A" ' change if needed 'id of first column to be copied Const firstColumn = "A" ' change if needed 'id of last column to be copied Const lastColumn = "C" ' change if needed Dim sourceList As Range Dim anySourceEntry As Range 'these deal with the list of entries that 'are to be found in the sourceList 'change the Const value(s) as needed. Const findListSheetName = "SearchForListSheet" Const findListColumn = "A" Dim findList As Range Dim foundItem As Range Dim anyFindEntry As Range 'these deal with the sheet where the results 'of the search operations will be reported/copied to 'change the Const value(s) as needed. Const reportSheetName = "FoundSheet" Const reportColumn = "A" Dim reportSheet As Worksheet 'used to copy from source list to the report sheet Dim cellsToCopy As Range 'set up reference to the list to be searched Set sourceList = ThisWorkbook.Worksheets(sourceListSheetName) _ .Range(searchColumn & "1:" & _ ThisWorkbook.Worksheets(sourceListSheetName) _ .Range(searchColumn & Rows.Count).End(xlUp).Address) 'set up reference to the list of entries to find Set findList = ThisWorkbook.Worksheets(findListSheetName) _ .Range(findListColumn & "1:" & _ ThisWorkbook.Worksheets(findListSheetName) _ .Range(findListColumn & Rows.Count).End(xlUp).Address) 'set up reference to the results reporting sheet Set reportSheet = ThisWorkbook.Worksheets(reportSheetName) 'clear any earlier results from the results sheet reportSheet.Cells.Clear ' clear contents and formatting 'begin the searching For Each anyFindEntry In findList If Not IsEmpty(anyFindEntry) Then Set foundItem = sourceList.Find(What:=anyFindEntry, _ LookIn:=xlFormulas, LookAt:=xlPart, _ SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, SearchFormat:=False) If Not foundItem Is Nothing Then 'found a match Set cellsToCopy = _ ThisWorkbook.Worksheets(sourceListSheetName) _ .Range(firstColumn & foundItem.Row & ":" & _ lastColumn & foundItem.Row) cellsToCopy.Copy reportSheet.Range(reportColumn & Rows.Count) _ .End(xlUp).Offset(1, 0).PasteSpecial _ Paste:=xlPasteAll cellsToCopy.ClearContents End If End If Next Application.CutCopyMode = False ' 'housekeeping Set reportSheet = Nothing Set findList = Nothing Set sourceList = Nothing Set cellsToCopy = Nothing End Sub "kingie" wrote: Hi, I have a large amount of data containing unique codes. I want to type in a list of codes and the program to find them in worksheet 1 Cut and paste it into worksheet 2. I can set up a macro to do the cut and paste but its long winded entering each code into the find box then waiting while the code is found then cut and paste using a macro. Any ideas on how i can speed it up please? |
#5
|
|||
|
|||
Find Cut and paste
Hi,
I am having problems knowing what to put where. In order to test it i have set up a small database to run it. There are 3 worksheets with the following names. "Data" (The columns of data i wish to search range A1:F20) "Found Codes" (The sheet that will hold the codes that have been copied and deleted) "Codes to find" (This is the sheet i enter the codes into that i wish to find, paste and delete from original data list) Could you possibly clarify which references i should enter into the code to make it work? Regards Charlie "JLatham" wrote: I have two solutions for you, the first code module will do the find with a COPY and paste. The second one does the equivalent of an actual CUT and paste. I wrote them since I wasn't sure if you really wanted cut and paste or just copy and paste. You'll need to change the values of various Const value declarations in them for them to work in your setup. To put the code to work, decide on which one you want to use, then open your workbook and press [Alt]+[F11] to open the Visual Basic editor and then choose Insert -- Module to open a new code module. Then copy the code segment you want to use and paste it into the code module, make required changes and close the VB editor. To use the code you'll need a sheet added to the workbook to put a list of codes to find into. That is all dealt with in this section of the code: Const reportSheetName = "FoundSheet" Const reportColumn = "A" Dim reportSheet As Worksheet So you need a sheet named FoundSheet added to the workbook, and you'll type the entries to be found into column A of it. Once you do that, you use Tools -- Macro -- Macros to select the macro you copied and [Run] it. Here's the find, COPY and paste code: Sub FindAndCopy() 'these all deal with the list to be searched 'it allows the search column to be in the 'middle of a group of columns that are to 'be copied when a match is found 'change the Const value(s) as needed. Const sourceListSheetName = "SourceListSheet" 'id of column with list to be searched Const searchColumn = "A" ' change if needed 'id of first column to be copied Const firstColumn = "A" ' change if needed 'id of last column to be copied Const lastColumn = "C" ' change if needed Dim sourceList As Range Dim anySourceEntry As Range 'these deal with the list of entries that 'are to be found in the sourceList 'change the Const value(s) as needed. Const findListSheetName = "SearchForListSheet" Const findListColumn = "A" Dim findList As Range Dim foundItem As Range Dim anyFindEntry As Range 'these deal with the sheet where the results 'of the search operations will be reported/copied to 'change the Const value(s) as needed. Const reportSheetName = "FoundSheet" Const reportColumn = "A" Dim reportSheet As Worksheet 'used to copy from source list to the report sheet Dim cellsToCopy As Range 'set up reference to the list to be searched Set sourceList = ThisWorkbook.Worksheets(sourceListSheetName) _ .Range(searchColumn & "1:" & _ ThisWorkbook.Worksheets(sourceListSheetName) _ .Range(searchColumn & Rows.Count).End(xlUp).Address) 'set up reference to the list of entries to find Set findList = ThisWorkbook.Worksheets(findListSheetName) _ .Range(findListColumn & "1:" & _ ThisWorkbook.Worksheets(findListSheetName) _ .Range(findListColumn & Rows.Count).End(xlUp).Address) 'set up reference to the results reporting sheet Set reportSheet = ThisWorkbook.Worksheets(reportSheetName) 'clear any earlier results from the results sheet reportSheet.Cells.ClearContents 'begin the searching For Each anyFindEntry In findList If Not IsEmpty(anyFindEntry) Then Set foundItem = sourceList.Find(What:=anyFindEntry, _ LookIn:=xlFormulas, LookAt:=xlPart, _ SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, SearchFormat:=False) If Not foundItem Is Nothing Then 'found a match Set cellsToCopy = _ ThisWorkbook.Worksheets(sourceListSheetName) _ .Range(firstColumn & foundItem.Row & ":" & _ lastColumn & foundItem.Row) cellsToCopy.Copy reportSheet.Range(reportColumn & Rows.Count) _ .End(xlUp).Offset(1, 0).PasteSpecial _ Paste:=xlPasteValues End If End If Next ' 'housekeeping Set reportSheet = Nothing Set findList = Nothing Set sourceList = Nothing Set cellsToCopy = Nothing End Sub and here is the find, CUT and paste code: Sub FindCopyAndDelete() 'effectively the same as cut and paste ' 'these all deal with the list to be searched 'it allows the search column to be in the 'middle of a group of columns that are to 'be copied when a match is found 'change the Const value(s) as needed. Const sourceListSheetName = "SourceListSheet" 'id of column with list to be searched Const searchColumn = "A" ' change if needed 'id of first column to be copied Const firstColumn = "A" ' change if needed 'id of last column to be copied Const lastColumn = "C" ' change if needed Dim sourceList As Range Dim anySourceEntry As Range 'these deal with the list of entries that 'are to be found in the sourceList 'change the Const value(s) as needed. Const findListSheetName = "SearchForListSheet" Const findListColumn = "A" Dim findList As Range Dim foundItem As Range Dim anyFindEntry As Range 'these deal with the sheet where the results 'of the search operations will be reported/copied to 'change the Const value(s) as needed. Const reportSheetName = "FoundSheet" Const reportColumn = "A" Dim reportSheet As Worksheet 'used to copy from source list to the report sheet Dim cellsToCopy As Range 'set up reference to the list to be searched Set sourceList = ThisWorkbook.Worksheets(sourceListSheetName) _ .Range(searchColumn & "1:" & _ ThisWorkbook.Worksheets(sourceListSheetName) _ .Range(searchColumn & Rows.Count).End(xlUp).Address) 'set up reference to the list of entries to find Set findList = ThisWorkbook.Worksheets(findListSheetName) _ .Range(findListColumn & "1:" & _ ThisWorkbook.Worksheets(findListSheetName) _ .Range(findListColumn & Rows.Count).End(xlUp).Address) 'set up reference to the results reporting sheet Set reportSheet = ThisWorkbook.Worksheets(reportSheetName) 'clear any earlier results from the results sheet reportSheet.Cells.Clear ' clear contents and formatting 'begin the searching For Each anyFindEntry In findList If Not IsEmpty(anyFindEntry) Then Set foundItem = sourceList.Find(What:=anyFindEntry, _ LookIn:=xlFormulas, LookAt:=xlPart, _ SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, SearchFormat:=False) If Not foundItem Is Nothing Then 'found a match Set cellsToCopy = _ ThisWorkbook.Worksheets(sourceListSheetName) _ .Range(firstColumn & foundItem.Row & ":" & _ lastColumn & foundItem.Row) cellsToCopy.Copy reportSheet.Range(reportColumn & Rows.Count) _ .End(xlUp).Offset(1, 0).PasteSpecial _ Paste:=xlPasteAll cellsToCopy.ClearContents End If End If Next Application.CutCopyMode = False ' 'housekeeping Set reportSheet = Nothing Set findList = Nothing Set sourceList = Nothing Set cellsToCopy = Nothing End Sub "kingie" wrote: Hi, I have a large amount of data containing unique codes. I want to type in a list of codes and the program to find them in worksheet 1 Cut and paste it into worksheet 2. I can set up a macro to do the cut and paste but its long winded entering each code into the find box then waiting while the code is found then cut and paste using a macro. Any ideas on how i can speed it up please? |
Thread Tools | |
Display Modes | |
|
|