nonduplicative merge

  • Thread starter Thread starter DrSteve
  • Start date Start date
D

DrSteve

I have several sheets with the following 2 columns:

PersonnelCode Name

The sheets share some, but not all, information.
Generally each sheet has some PersonnelCode-Name pairs
that are unique to the sheet. The PersonnelCode and Name
sets are themselves one-to-one.

I would like to write a macro that will produce, in 2
corresponding columns on a master sheet, a nonduplicative
merge of all the columns of PersonnelCode and Name
information. I can do this with hooks into Excel from
some external DB/data processing apps, but would like to
do it all from within Excel if I can.

Many thanks in advance.
 
Say your data were in columns A and B of each worksheet.

I'd insert a new worksheet.
copy all the info from each worksheet (only one header row, though) into that
new worksheet.

Then add another column and add a formula:

=A2&char(1)&b2
Drag down the length of the column.

Then apply Data|filter|advanced filter to column C and show only the unique
entries.

Then copy those visible cells from A:B to a new sheet.
 
I think the below will do the trick. It will create the sheet with the
unique ID's at the end automatically. It assumes that the relvant info is in
col 1 and 2 of each sheet. It will look in all sheets of the Active
Workbook. Didn't do a lot of validation, you might want to test it with a
small set of combinations first.
Hope this is what you are looking for, you can copy it right into a module.
Felix

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

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

'Fill the array with unique pairs
For Each MySheet In ActiveWorkbook.Worksheets
For i = 1 To MySheet.UsedRange.Rows.Count
x1 = CStr(MySheet.Cells(i, 1).Value)
x2 = CStr(MySheet.Cells(i, 2).Value)
For ii = 0 To EndArray
If x1 = MyArray(ii, 0) Then
If x2 = MyArray(ii, 1) Then Exit For
ElseIf MyArray(ii, 0) = Empty Then
MyArray(ii, 0) = x1
MyArray(ii, 1) = x2
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 Name combinations
For i = 0 To EndArray
ActiveSheet.Cells(i + 1, 1).Value = MyArray(i, 0)
ActiveSheet.Cells(i + 1, 2).Value = MyArray(i, 1)
If MyArray(i, 0) = Empty Then Exit For
Next

End Sub
 
Thanks for the responses. I was looking for something
that could be run from a button, so the scripting option
looks preferable at the moment.

Best Regards,
DrSteve
-----Original Message-----
I have several sheets with the following 2 columns:

PersonnelCode Name
Click to expand...
[snip]
 
Back
Top