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?

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?

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?

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?

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?