View Single Post
  #5   Report Post  
Posted to microsoft.public.excel.programming
joel joel is offline
external usenet poster
 
Posts: 9,101
Default Compare & align like items from 2 Roaster columns of Employees

the code below I simply opened two workbooks and copied the data to column A
and B like you original input. then ran the rest of the code unchanged. You
may need to change the worksheet names in the two workbooks that get opened.
I used Sheet1 in the code below.


Sub CombineLists()


filetoOpen = Application _
.GetOpenFilename("Excel Files (*.xls), *.xls")
If filetoOpen = False Then
MsgBox "Cannot open file - Exiting Sub"
Exit Sub
End If

Set bk = Workbooks.Open(Filename:=filetoOpen)
bk.Sheets("Sheet1").Columns("A").Copy _
Destination:=ThisWorkbook.Sheets("Sheet1").Columns ("A")
bk.Close

filetoOpen = Application _
.GetOpenFilename("Excel Files (*.xls), *.xls")
If filetoOpen = False Then
MsgBox "Cannot open file - Exiting Sub"
Exit Sub
End If

Set bk = Workbooks.Open(Filename:=filetoOpen)
bk.Sheets("Sheet1").Columns("A").Copy _
Destination:=ThisWorkbook.Sheets("Sheet1").Columns ("B")
bk.Close

'Insert Blank row to get rid of Excel Error in Advance filter duplicating
'first entry
Rows(1).Insert

'1st get a unique list of names
'Make a combined list in columnC
'copy A to C
Columns("A").Copy Destination:=Columns("C")
LastRowB = Range("B" & Rows.Count).End(xlUp).Row
LastRowC = Range("C" & Rows.Count).End(xlUp).Row
'Copy Column B to End of Column C
Range("B2:B" & LastRowB).Copy _
Destination:=Range("C" & (LastRowC + 1))

'sort Row C
LastRowC = Range("C" & Rows.Count).End(xlUp).Row
Set sortRange = Range("C2:C" & LastRowC)
sortRange.Sort _
Key1:=Range("C1"), _
Order1:=xlAscending, _
Header:=xlNo
'Get Unique Records and place in Column D
sortRange.AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=Range("D1"), _
Unique:=True

'Put Data in from: column B and C to: E and F in the correct rows
For ColCount = 1 To 2
LastRow = Cells(Rows.Count, ColCount).End(xlUp).Row
For RowCount = 2 To LastRow
If Cells(RowCount, ColCount) < "" Then
Person = Cells(RowCount, ColCount)
Set c = Columns("D").Find(what:=Person, _
LookIn:=xlValues, lookat:=xlWhole)
c.Offset(0, ColCount) = Person
End If
Next RowCount
Next ColCount

'Delete columns A to D
Columns("A:D").Delete
'Delete Row 1
Rows(1).Delete
End Sub


"u473" wrote:

Thank you very much, that was quite an education. I will put it to
test right away.
Last cherry on the cake, syntax wise, how do I refer to data in
separate workbooks.
Old Roaster from Workbook A , New Roaster from Workbook B , all using
sheet1 Col A,
and Result in Workbook C ,
Having originally all the data on the same sheet was only for the
convenience of this research.
Thank you again.
J.P.