PDA

View Full Version : Find match copy paste from another closed workbook



VNouBA
05-23-2014, 11:31 AM
I have a code that I cannot find the solution.

I will have my main workbook open and on a Command_Button I need to open a closed workbook that will be in a specific path.

I need to Find match the value of all data in my Column A in my Closed workbook and match the data in my main workbook. I need a loop that will get all information from this closed workbook, look in my main workbook for a match and then change the information from that row from B to Z then go to the next matching data and so on. Once complete, close the workbook(2) and remain in my Main workbook.

Kind of retrieving data but matching 2 columns from different workbooks.

Where would I start?


An example would be the following:

My ActiveWorkbook (“Main”).Sheets(“Sheet1”).Range(“A2:A”) will have a cmd button, on press

Open Workbook2 = Filepath:=“C:\Users\Name\Desktop\My other workbook.xlsm”

In my Workbook2 look in Column C for all matching data in Wb1 in Column A, if found, copy information from Wb2 in range B to Z and paste information in wb1 in matching row then loop until.

Once complete, close wb2.



Please help

VNouBA
05-26-2014, 06:58 AM
Still working on this if anyone could direct me to the right path...

Would be appreciated.

VNouBA
05-26-2014, 07:21 AM
I have the following code as a test but I am trying to retreive the information from my Wb2 to then populate my WB1 but this code only takes Wb1's information opens wb2 then transfer the information to wb2.



Private Sub CommandButton1_Click()
Dim wb1 As Workbook, wb2 As Workbook
Dim ws As Worksheet
Dim filePath As String
Dim searchValue As Variant
Dim myRange As Range
Dim fCell As Range
filePath = "C:\Users\Name\Desktop\VBA Projects\name\Wb2.xlsm"
Set wb1 = ActiveWorkbook
Set myRange = ActiveSheet.Range("A1:Z100")
searchValue = ActiveSheet.Range("A1:A10000").Value
Application.ScreenUpdating = False
'Open wb2
Set wb2 = Workbooks.Open(filePath)
'Search and find
Set fCell = Nothing
For Each ws In wb2.Worksheets
Set fCell = ws.Cells.Find(searchValue)
'Stop when we find the value
If Not fCell Is Nothing Then
myRange.Copy
fCell.PasteSpecial (xlPasteValues)
Exit For
End If
Next ws
With wb2
Application.CutCopyMode = False
End With
wb2.Close True
Application.ScreenUpdating = True
End Sub

OG Loc
05-28-2014, 02:09 AM
Sounds like you need something like:


Private Sub CommandButton1_Click()
Dim wb As Workbook, wb2 As Workbook
Dim ws As Worksheet
Dim filePath As String
Dim myRange As Range
Dim c as Cell

filePath = "C:\Users\Name\Desktop\VBA Projects\name\Wb2.xlsm"
Set wb = ActiveWorkbook

Set myRange = ActiveSheet.Range("A1:A100")
Application.ScreenUpdating = False

'Open wb2
Set wb2 = Workbooks.Open(filePath)

' now loop down both ranges comparing the values, and if equal copy across whatever needs to be copied
For Each c in myRange
If c.value=wb2.ActiveSheet.cells(c.Row,c.Column).Value Then
' in this case, the things were equal, so we do the copying
wb.ActiveSheet.Cells(c.Row,c.Column+1) = wb2.ActiveSheet.Cells(c.Row,c.Column+1) ' does column B
wb.ActiveSheet.Range("C" & c.Row & ":Z" & c.Row)=wb2.ActiveSheet.Range("C" & c.Row & ":Z" & c.Row) ' does C to Z
End if
Next c

wb2.Close True
Application.ScreenUpdating = True
End Sub


I haven't tried this, it probably won't even compile, but should get you started. Hopefully you can see how I meant for it to work. Do ask questions on it if you want!

VNouBA
05-28-2014, 09:28 AM
I changed the Dim c As Range as I was getting an error with the Dim c As Cell.

What it is doing is the following:

Opening my Ws2 (The search workbook) and going back to my main workbook, Deleting everything in my Main workbook and closing my Ws2.

Will try to figure out this ;)

OG Loc
05-29-2014, 01:40 AM
I changed the Dim c As Range as I was getting an error with the Dim c As Cell.

What it is doing is the following:

Opening my Ws2 (The search workbook) and going back to my main workbook, Deleting everything in my Main workbook and closing my Ws2.

Will try to figure out this ;)

Oh dear! I think rather than deleting it is it actually overwriting it with nothing i.e. its copying blank cells from wb2 into wb1. Might need to be more specific about what sheets things are on, so replace 'ActiveSheet' with 'Sheets("NameofSheet") in the copying part of the code.