Merging Data

  • Thread starter Thread starter Al Mackay
  • Start date Start date
A

Al Mackay

Is it possible to do the following.

I have two separate spreadsheets that contain data in. Each record
within the spreadsheet has a unique identifier (Info Record).

Want to be able to merge the data from the two spreadsheets (Sheet 1 +
Sheet 2) into one (Sheet 3) based on the Info Record key. So where
the same Info Record numbers appear in each spreadsheet the data is
all brought together into a third spreadsheet.

Appreciate your help on this.

Kind Regards, Al Mackay. ( (e-mail address removed) )


** SHEET 1 **
Info record Material Vendor Valid to
5300000000 0000443XSH 1004 00.00.0000
5300000001 0000444XSH 1004 00.00.0000
5300000002 67065257SH 1004 00.00.0000
5300000003 67105745SH 1004 00.00.0000
5300000004 0000442XSH 1004 00.00.0000
5300000005 0001002XSH 1004 00.00.0000
5300000006 0000755SH 1004 00.00.0000
5300000007 0001003XSH 1004 00.00.0000
5300000008 0001000XSH 1004 00.00.0000
5300000009 0001001XSH 1004 00.00.0000
5300000010 50654952BO 1004 00.00.0000


** SHEET 2 **
Info Record Plant Currency
5300000000 GB01 GBP
5300000001 GB01 GBP
5300000002 GB01 GBP
5300000003 GB01 GBP
5300000004 GB01 GBP
5300000005 GB01 GBP
5300000006 GB01 GBP
5300000007 GB01 GBP
5300000008 GB01 GBP
5300000009 GB01 GBP
5300000010 GB01 GBP
5300000011 GB01 GBP
5300000012 GB01 GBP
5300000013 GB01 GBP
5300000014 GB01 GBP



** FINAL LOOK - SHEET 3 **
Info record Material Vendor Valid to Plant Currency
5300000000 0000443XSH 1004 00.00.0000 GB01 GBP
5300000001 0000444XSH 1004 00.00.0000 GB01 GBP
5300000002 67065257SH 1004 00.00.0000 GB01 GBP
5300000003 67105745SH 1004 00.00.0000 GB01 GBP
5300000004 0000442XSH 1004 00.00.0000 GB01 GBP
5300000005 0001002XSH 1004 00.00.0000 GB01 GBP
5300000006 0000755SH 1004 00.00.0000 GB01 GBP
5300000007 0001003XSH 1004 00.00.0000 GB01 GBP
5300000008 0001000XSH 1004 00.00.0000 GB01 GBP
5300000009 0001001XSH 1004 00.00.0000 GB01 GBP
5300000010 50654952BO 1004 00.00.0000 GB01 GBP
 
I think the below will work for your purpose. It's not
optimized so it may runs longer than it needs to. It works
with any number of sheets and will add a sheet with the
common id's at the first position.
Hope this helps,
Felix

Sub CommonIDs()
Dim MySheet As Worksheet
Dim EndArray As Double
Dim MyArray
Dim i, ii, iii, x1, NumOfSheets, NumOfOccurance

'Find the maximum number of ids
For Each MySheet In ActiveWorkbook.Worksheets
EndArray = EndArray + MySheet.UsedRange.Rows.Count
NumOfSheets = NumOfSheets + 1
Next

'Create an Array of the maximum size
ReDim MyArray(EndArray, NumOfSheets)

'Reset the Number of Sheets
NumOfSheets = 0
'Fill the array with ID's
For Each MySheet In ActiveWorkbook.Worksheets
NumOfSheets = NumOfSheets + 1
For i = 1 To MySheet.UsedRange.Rows.Count
x1 = CStr(MySheet.Cells(i, 1).Value)
For ii = 0 To EndArray
If x1 = MyArray(ii, 0) Then
'Set a flag if an ID was found in the sheet
MyArray(ii, NumOfSheets) = 1
Exit For
ElseIf MyArray(ii, 0) = Empty Then
MyArray(ii, 0) = x1
MyArray(ii, NumOfSheets) = 1
Exit For
End If
Next
Next
Next

'Select the first sheet
Sheets(1).Select
'Add a new sheet
Sheets.Add

'Fill the sheet with unique ID's
For i = 0 To EndArray
NumOfOccurance = 0
For ii = 1 To NumOfSheets
NumOfOccurance = NumOfOccurance + MyArray(i, ii)
Next
If NumOfOccurance = NumOfSheets Then
iii = iii + 1
ActiveSheet.Cells(iii, 1).Value = MyArray(i, 0)
End If
If MyArray(i, 0) = Empty Then Exit For
Next

End Sub
 
The below code will do what you want with all sheets in a
workbook (1 to n) and then create a new sheet with the
common ID's. My appology if this message gets posted twice.
Felix

Sub CommonIDs()
Dim MySheet As Worksheet
Dim EndArray As Double
Dim MyArray
Dim i, ii, iii, x1, NumOfSheets, NumOfOccurance
'Find the maximum number of combinations
For Each MySheet In ActiveWorkbook.Worksheets
EndArray = EndArray + MySheet.UsedRange.Rows.Count
NumOfSheets = NumOfSheets + 1
Next

'Create an Array of the maximum size
ReDim MyArray(EndArray, NumOfSheets)

'Reset the Number of Sheets
NumOfSheets = 0
'Fill the array with ID's
For Each MySheet In ActiveWorkbook.Worksheets
NumOfSheets = NumOfSheets + 1
For i = 1 To MySheet.UsedRange.Rows.Count
x1 = CStr(MySheet.Cells(i, 1).Value)
For ii = 0 To EndArray
If x1 = MyArray(ii, 0) Then
'Set a flag if an ID was found in the sheet
MyArray(ii, NumOfSheets) = 1
Exit For
ElseIf MyArray(ii, 0) = Empty Then
MyArray(ii, 0) = x1
MyArray(ii, NumOfSheets) = 1
Exit For
End If
Next
Next
Next

'Select the first sheet
Sheets(1).Select
'Add a new sheet
Sheets.Add

'Fill the sheet with unique ID's
For i = 0 To EndArray
NumOfOccurance = 0
For ii = 1 To NumOfSheets
NumOfOccurance = NumOfOccurance + MyArray(i, ii)
Next
If NumOfOccurance = NumOfSheets Then
iii = iii + 1
ActiveSheet.Cells(iii, 1).Value = MyArray(i, 0)
End If
If MyArray(i, 0) = Empty Then Exit For
Next

End Sub
 
The below should do what you want for all sheets in a
workbook (1 to n). It will create a new sheet with the
common ID's at the end. This may get posted twice, sorry
about that.

Sub CommonIDs()
Dim MySheet As Worksheet
Dim EndArray As Double
Dim MyArray
Dim i, ii, iii, x1, NumOfSheets, NumOfOccurance
'Find the maximum number of combinations
For Each MySheet In ActiveWorkbook.Worksheets
EndArray = EndArray + MySheet.UsedRange.Rows.Count
NumOfSheets = NumOfSheets + 1
Next

'Create an Array of the maximum size
ReDim MyArray(EndArray, NumOfSheets)

'Reset the Number of Sheets
NumOfSheets = 0
'Fill the array with ID's
For Each MySheet In ActiveWorkbook.Worksheets
NumOfSheets = NumOfSheets + 1
For i = 1 To MySheet.UsedRange.Rows.Count
x1 = CStr(MySheet.Cells(i, 1).Value)
For ii = 0 To EndArray
If x1 = MyArray(ii, 0) Then
'Set a flag if an ID was found in the sheet
MyArray(ii, NumOfSheets) = 1
Exit For
ElseIf MyArray(ii, 0) = Empty Then
MyArray(ii, 0) = x1
MyArray(ii, NumOfSheets) = 1
Exit For
End If
Next
Next
Next

'Select the first sheet
Sheets(1).Select
'Add a new sheet
Sheets.Add

'Fill the sheet with unique ID's
For i = 0 To EndArray
NumOfOccurance = 0
For ii = 1 To NumOfSheets
NumOfOccurance = NumOfOccurance + MyArray(i, ii)
Next
If NumOfOccurance = NumOfSheets Then
iii = iii + 1
ActiveSheet.Cells(iii, 1).Value = MyArray(i, 0)
End If
If MyArray(i, 0) = Empty Then Exit For
Next

End Sub
 
Back
Top