Macro to search, find, copy rows and replace

[Closed]
Report
-
Posts
1864
Registration date
Sunday June 14, 2009
Status
Contributor
Last seen
August 7, 2021
-
Hello,

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.Clear
.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

'theCellReference.

'& theReferencePrefix & fnd.Address


'Range("N:O").Select
'Selection.Copy



'Range("N:O").Select
'ActiveSheet.PasteSpecial



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


wbB.Close SaveChanges:=False

End Sub

1 reply

Posts
1864
Registration date
Sunday June 14, 2009
Status
Contributor
Last seen
August 7, 2021
802
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
2
Thank you

A few words of thanks would be greatly appreciated. Add comment

CCM 2821 users have said thank you to us this month