Macro to search, find, copy rows and replace

JoshMarotte - Jun 20, 2012 at 02:14 PM
venkat1926 Posts 1863 Registration date Sunday June 14, 2009 Status Contributor Last seen August 7, 2021 - Jun 20, 2012 at 10:23 PM

I am trying to create a macro to search for a number from one workbook in another workbook, and then either copy the entire row or copy the necessary cells from the second workbook back to the original, either replacing the entire row, or inserting the necessary cells.

Neither workbook are sorted, and that's where I am having trouble...

I can call up the file for which to search, but once it finds that number, I am having trouble getting the macro to copy the selected values and paste it back into the original...

The coding below is very messy and sloppy, and I apologize, but anyone willing to take a look for me and see if they can help, it would be appreciated!

I don't know what is easier, replacing the whole row or adding the two cell values needed (in columns N and O, but again, not sorted so I do not have a start point).

Sub Search()

' get the reference to the active sheet
Dim theSheet As Worksheet
Set theSheet = ActiveSheet

' get the range of selected cells
Dim theActiveRange As Range
Set theActiveRange = Selection

' ask the user for the workbook to be searched
' ask the user for the workbook to be searched
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "Select the Excel file to be searched"
.AllowMultiSelect = False
.Filters.Add "Excel Files", "*.xl*"
If (.Show = 0) Then ' abort if the user cancels the selection
Exit Sub
End If

' open the selected file
Dim FileName As String
FileName = .SelectedItems(1)
Dim wbB As Workbook
Set wbB = Workbooks.Open(FileName:=FileName, ReadOnly:=True)

' build the cell reference prefix
Dim thePath As String
Dim theName As String
Dim thePathEnd As Long
thePathEnd = InStrRev(FileName, "\")
thePath = Mid(FileName, 1, thePathEnd)
theName = Mid(FileName, thePathEnd + 1)
Dim theReferencePrefix As String
theReferencePrefix = "'" & thePath & "[" & theName & "]Sheet1'!"
End With

' loop through all of the cells in the selected range
Dim theCell As Range
For Each theCell In theActiveRange

' get the value from this cell
Dim theValue As String
theValue = theCell.Value

' get the row of this cell and build a reference to
' the cell's row and column N
Dim theRow As Long
theRow = theCell.Row
'Dim theCellReference As Range
'Set theCellReference = theSheet.Cells(theRow, 14)

' search the first sheet for this value
Dim fnd As Range
Set fnd = wbB.Sheets(1).UsedRange.Find(theValue)

' if found, put a reference to this cell in the
' first workbook in column N
If (Not fnd Is Nothing) Then

' get the reference to this row and column N

' set the formula in this cell to refer to
' the found cell


'& theReferencePrefix & fnd.Address



'theCellReference.Value = "Not Found"
End If
Next theCell

wbB.Close SaveChanges:=False

End Sub

1 response

venkat1926 Posts 1863 Registration date Sunday June 14, 2009 Status Contributor Last seen August 7, 2021 811
Jun 20, 2012 at 10:23 PM
try this method (if necessry record macro)

autofilter data for the NUMBER as criteria in the relevant column

copy the data (without header column) and paste it to sheet 1 wherever you want
clear autofilter

take this as exercise on real data