Teach me to Merge Data
 

Hello All,
Would someone be prepared to teach me how to do what I need in my question
below?

If possible (willing) please help.

I am trying to copy data from one file into another.
I have copied code from various sites and tried to manipulate that code to
do what I want it to do.
No success, as I am a novice code writing understanding what is happening
and how to change it is the problem.

I need your help if possible please.

Here is what I would like to happen.
The base or main file is called RMA.xls.
The other file which is e-mailed to me is called RMA LMR.xls.
Columns A to K have the same headings in the two files.
In the RMA.xls file Columns L to P are different to RMA LMR.xls and unique.
RMA LMR.xls has Columns L to M that are different and unique to this file.

Column B has the list of unique ID for both files.
What must happen is as follows:
1: RMA.xls. is open and RMA LMR.xls must be found and selected to be opened.
2: Compare the two ID keys to see that they correspond. RMA LMR.xls to
RMA.xls. (RMA.xls.is the base).
3: Copy the data in Column L and M from RMA LMR.xls. to RMA.xls, ensuring
that the relevant Ids match exactly.
4: Close RMA LMR.xls.
5: Save RMA.xls.

If you are able please help.

Thank you and best regards

Max

Teach me to Merge Data
 

Hi Max

Place this code in RMA.xls.
I assume you want to copy data from column L and M to column L and M in
RMA.xls, and data is in Sheet1 in both workbooks.

Sub MergeData()
Dim wbA As Workbook
Dim wbB As Workbook
Dim shA As Worksheet
Dim shB As Worksheet
Dim IdRangeA As Range
Dim IdRangeB As Range
Dim IdCol As String
Dim FirstRow As Long, LastRowA As Long, LastRowB As Long

Set wbA = ThisWorkbook
Set wbB = Workbooks.Open(Application.GetOpenFilename)
Set shA = wbA.Worksheets("Sheet1")
Set shB = wbB.Worksheets("Sheet1")

IdCol = "B"
FirstRow = 2 ' Headings in row 1
LastRowA = shA.Range(IdCol & Rows.Count).End(xlUp).Row
LastRowB = shB.Range(IdCol & Rows.Count).End(xlUp).Row
Set IdRangeA = shA.Range(IdCol & FirstRow, IdCol & LastRowA)
Set IdRangeB = shB.Range(IdCol & FirstRow, IdCol & LastRowB)

For Each ID In IdRangeB
Set f = IdRangeA.Find(ID.Value, After:=shA.Range(IdCol & 2), _
LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlNext)
If Not f Is Nothing Then
ID.Offset(0, 10).Resize(1, 2).Copy Destination:= f.Offset(0, 10)
Else
msg = MsgBox("Id " & ID.Value & " was not found in " & _
ActiveWorkbook.Name & vbLf & vbLf & _
"Click OK to continue", vbInformation, "Warning!")
End If
Next
wbB.Close
wbA.Save
End Sub

Regards,
Per

"Max" skrev i meddelelsen
...
Hello All,
Would someone be prepared to teach me how to do what I need in my question
below?

If possible (willing) please help.

I am trying to copy data from one file into another.
I have copied code from various sites and tried to manipulate that code to
do what I want it to do.
No success, as I am a novice code writing understanding what is happening
and how to change it is the problem.

I need your help if possible please.

Here is what I would like to happen.
The base or main file is called RMA.xls.
The other file which is e-mailed to me is called RMA LMR.xls.
Columns A to K have the same headings in the two files.
In the RMA.xls file Columns L to P are different to RMA LMR.xls and
unique.
RMA LMR.xls has Columns L to M that are different and unique to this file.

Column B has the list of unique ID for both files.
What must happen is as follows:
1: RMA.xls. is open and RMA LMR.xls must be found and selected to be
opened.
2: Compare the two ID keys to see that they correspond. RMA LMR.xls to
RMA.xls. (RMA.xls.is the base).
3: Copy the data in Column L and M from RMA LMR.xls. to RMA.xls, ensuring
that the relevant Ids match exactly.
4: Close RMA LMR.xls.
5: Save RMA.xls.

If you are able please help.

Thank you and best regards

Max

Teach me to Merge Data
 

You have to change the sheet names but everything else can remain the same

Sub MergeFiles()


FiletoOpen = Application _
.GetOpenFilename(Filefilter:="Excel Files (*.xls), *.xls", _
Title:="OPen LMR file")
If FiletoOpen = False Then
MsgBox ("Cannot Open file - Exing Macro")
Exit Sub
End If

Set BaseFile = Workbooks("RMA.xls")
Set BaseSht = BaseFile.Sheets("Sheet1")

Set LMSFile = Workbooks.Open(Filename:=FiletoOpen)
Set LMSSht = LMSFile.Sheets("Sheet1")

'Add data that is not found to the end of the worksheet
LastRow = BaseSheet.Range("B" & Rows.Count).End(xlUp).Row
NewRow = LastRow + 1

With LMSSht
RowCount = 1
Do While .Range("B" & RowCount) < ""
ID = .Range("B" & RowCount)
Set NewDat = .Range("L" & RowCount & ":M" & RowCount)

With BaseSht
Set c = .Columns("B").Find(what:=ID, _
LookIn:=xlValues, lookat:=xlWhole)

If c Is Nothing Then
'Add New row
.Range("A" & NewRow) = ID
NewData.Copy Destination:=.Range("L" & NewRow)
NewRow = NewRow + 1
Else
NewData.Copy Destination:=.Range("L" & c.Row)
End If
End With
RowCount = RowCount + 1
Loop
End With

End Sub


"Max" wrote:

Hello All,
Would someone be prepared to teach me how to do what I need in my question
below?

If possible (willing) please help.

I am trying to copy data from one file into another.
I have copied code from various sites and tried to manipulate that code to
do what I want it to do.
No success, as I am a novice code writing understanding what is happening
and how to change it is the problem.

I need your help if possible please.

Here is what I would like to happen.
The base or main file is called RMA.xls.
The other file which is e-mailed to me is called RMA LMR.xls.
Columns A to K have the same headings in the two files.
In the RMA.xls file Columns L to P are different to RMA LMR.xls and unique.
RMA LMR.xls has Columns L to M that are different and unique to this file.

Column B has the list of unique ID for both files.
What must happen is as follows:
1: RMA.xls. is open and RMA LMR.xls must be found and selected to be opened.
2: Compare the two ID keys to see that they correspond. RMA LMR.xls to
RMA.xls. (RMA.xls.is the base).
3: Copy the data in Column L and M from RMA LMR.xls. to RMA.xls, ensuring
that the relevant Ids match exactly.
4: Close RMA LMR.xls.
5: Save RMA.xls.

If you are able please help.

Thank you and best regards

Max