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 said:
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?
