Developer Forum

Sub ArchiveData()
Dim NextCol As Long
'Check if destination workbook is open already, open it if necessary
On Error Resume Next
Workbooks("destination.xls").Activate
If Err <> 0 Then Workbooks.Open "destionation.xls"

'Copy data
NextCol = Workbooks("destination.xls").Sheets("WPS Detail
Dates").Range("A2").Value
Windows("source.xls").Activate
Columns("A:D").Copy

'Paste data to new column and insert archive date
Workbooks("destination.xls").Sheets("WPS Detail Dates").Activate
Columns(NextCol).PasteSpecial xlPasteAll
Application.CutCopyMode = True
Cells(2, NextCol) = Date
Columns(NextCol).HorizontalAlignment = xlCenter
Columns(NextCol).AutoFit

End Sub.


I have a large two workbook (destination.xls and source.xls), that track
training of employee. The source.xls is link to the database such a way that
whenever i open, it pull Automatic update from the database. Manager has
list of employee under him that have undergone the training and these names
sometimes occur more than one time because they have two or more training.
I am trying to set up way that after update pulled by source.xls from the
database should Automatically copies to Destination.xls on a particular rows
and also only pick one name at a time if they appear more than one time"maybe
pick the first occured of each name" and cordinate the name by Manager. For
example

"SOURCE.XLS"
A B C D
A1 EMPLOYEE ID COURSE NAME MANAGER
Kim Bell 002 Sales Training Brian
Kim Bell 002 Safety Training Brian
Lee Paul 003 Light Training Mark
Lee Paul 003 Sales Training Mark.
"DESTINATION.XLS"

B C D

B11 MANAGER EMPLOYEE ID
BRIAN Kim Bell 002
MARK Lee Paul 003

I mean the names should appear on the destination.xls automatically
according to thier MANAGER and each name should appear once on the
destination.xls "sheet1" even if new staff data pulled from database to
source.xls.
The COURSE NAME ROW is neccesary but it can be s *** out if it will prevent
us to achieve what we want. I want to use above code or if any other can
work.

Please your taught and help will be much more welcome and appreciate your
time. Thank you and look forward to hear from you.

May be:

Sub m()
Dim swb As Workbook
Dim twb As Workbook
Set sws = Workbooks("source.xls")
Set twb = Workbooks("destination.xls")

Dim sws As Worksheet
Dim tws As Worksheet
Set sws = swb.ActiveSheet
Set tws = twb.ActiveSheet

sws.Range("A1").CurrentRegion.Sort _
key1:=Range("D2"), order1:=xlAscending, _
key2:=Range("A2"), order2:=xlAscending, _
Header:=xlYes
sws.Columns("D:D").Copy tws.Range("B1")
sws.Columns("A:B").Copy tws.Range("C1")

tws.Activate
lrow = Cells(Rows.Count, "B").End(xlUp).Row
For i = lrow To 2 Step -1
If Cells(i, "I") = Cells(i - 1, "C") Then Rows(i).Delete
Next i

End Sub
"Kanmi" < XXXX@XXXXX.COM > wrote in message
news: XXXX@XXXXX.COM ...

If Cells(i, "I") = Cells(i - 1, "C") Then Rows(i).Delete
should read If Cells(i, "C") = Cells(i - 1, "C") Then Rows(i).Delete

"KC" < XXXX@XXXXX.COM > wrote in message
news:OIsfvor% XXXX@XXXXX.COM ...