Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Automatic Data Management
Sub CreateMaster() Set Source = Workbooks("Source.xls") Set SourceSht = Source.Sheets("Sheet1") Set Dest = Workbooks("Destination.xls") 'create new worksheet With Dest Set DestSht = .Sheets.Add(after:=.Sheets(.Sheets.Count)) End With With DestSht SourceSht.Columns("A:A").Copy _ Destination:=.Columns("D:D") Lastrow = .Range("D" & Rows.Count).End(xlUp).Row .Range("D1:D" & Lastrow).AdvancedFilter _ Action:=xlFilterCopy, _ CopyToRange:=.Range("C11"), _ Unique:=True 'delete temporay column D .Columns("D").Delete .Range("B11") = "MANAGER" .Range("D11") = "ID" Lastrow = .Range("C" & Rows.Count).End(xlUp).Row For RowCount = 12 To Lastrow Employee = .Range("C" & RowCount) With SourceSht Set c = .Columns("A").Find(what:=Employee, _ LookIn:=xlValues, lookat:=xlWhole) If c Is Nothing Then MsgBox ("Cannot find employee : " & Employee) Else Manager = .Range("D" & c.Row) ID = .Range("B" & c.Row) End If End With If Not c Is Nothing Then .Range("B" & RowCount) = Manager .Range("D" & RowCount) = ID End If Next RowCount End With 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 ---------------- -A1:G1 A B C D E F G Employee Login ID ID Hire Date Title Email Manager kim Belly kima 001 06/21/01 MD kim@ Jen kim Belly kima 001 06/21/01 MD kim@ Jen Fue Lee leeo 002 02/07/02 SALES leeo@ Mark Ben Jud bee 003 02/07/02 MD bee@ JEN Yao yu yao 004 02/25/05 MA yao@ Tim- Yao yu yao 004 02/25/05 MA yao@ Tim Yao yu yao 004 02/25/05 MA yao@ Tim DESTINATION.XLS ---------------------- A B C D E F G SALES ID Employee Hire Date Manager Reg Title N/A 001 KIM BELLY 06/21/01 JEN N/A MD N/A 003 BEN JUD 02/07/02 JEN N/A MD N/A 002 FUE LEE 02/07/02 MARK N/A SALES N/A 004 YAO YO 02/25/05 TIM N/A MA This is how the page appeared on each workbook and i have arrange destination.xls the way i want it to work. I want destination.xls automatically pulled update from source.xls and list them according to the manager and even if new students were added then should automatically appear under it manager. I got the VB CODE ABOVE TO EDIT AND SEE OTHER WAYS TO ACHIEVE THIS. I know this might hard to go through but i will appreciate any advice or help because it all chanllenge. Thanks and God bless you. |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Automatic Data Management
Kanmi- Check the Excel VBA help file for "Match"- if you want to avoid duplicates, use the Match function to see if the item already exists. If not, add the row; if it does already exist, then skip to the next row of data. Try searching past posts for "Match" to find code snippets to fully understand how it can be used and then incorporate into your existing code as needed. HTH, Keith "Kanmi" wrote: Sub CreateMaster() Set Source = Workbooks("Source.xls") Set SourceSht = Source.Sheets("Sheet1") Set Dest = Workbooks("Destination.xls") 'create new worksheet With Dest Set DestSht = .Sheets.Add(after:=.Sheets(.Sheets.Count)) End With With DestSht SourceSht.Columns("A:A").Copy _ Destination:=.Columns("D:D") Lastrow = .Range("D" & Rows.Count).End(xlUp).Row .Range("D1:D" & Lastrow).AdvancedFilter _ Action:=xlFilterCopy, _ CopyToRange:=.Range("C11"), _ Unique:=True 'delete temporay column D .Columns("D").Delete .Range("B11") = "MANAGER" .Range("D11") = "ID" Lastrow = .Range("C" & Rows.Count).End(xlUp).Row For RowCount = 12 To Lastrow Employee = .Range("C" & RowCount) With SourceSht Set c = .Columns("A").Find(what:=Employee, _ LookIn:=xlValues, lookat:=xlWhole) If c Is Nothing Then MsgBox ("Cannot find employee : " & Employee) Else Manager = .Range("D" & c.Row) ID = .Range("B" & c.Row) End If End With If Not c Is Nothing Then .Range("B" & RowCount) = Manager .Range("D" & RowCount) = ID End If Next RowCount End With 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 ---------------- -A1:G1 A B C D E F G Employee Login ID ID Hire Date Title Email Manager kim Belly kima 001 06/21/01 MD kim@ Jen kim Belly kima 001 06/21/01 MD kim@ Jen Fue Lee leeo 002 02/07/02 SALES leeo@ Mark Ben Jud bee 003 02/07/02 MD bee@ JEN Yao yu yao 004 02/25/05 MA yao@ Tim- Yao yu yao 004 02/25/05 MA yao@ Tim Yao yu yao 004 02/25/05 MA yao@ Tim DESTINATION.XLS ---------------------- A B C D E F G SALES ID Employee Hire Date Manager Reg Title N/A 001 KIM BELLY 06/21/01 JEN N/A MD N/A 003 BEN JUD 02/07/02 JEN N/A MD N/A 002 FUE LEE 02/07/02 MARK N/A SALES N/A 004 YAO YO 02/25/05 TIM N/A MA This is how the page appeared on each workbook and i have arrange destination.xls the way i want it to work. I want destination.xls automatically pulled update from source.xls and list them according to the manager and even if new students were added then should automatically appear under it manager. I got the VB CODE ABOVE TO EDIT AND SEE OTHER WAYS TO ACHIEVE THIS. I know this might hard to go through but i will appreciate any advice or help because it all chanllenge. Thanks and God bless you. |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Automatic Data Management
I wrote 2 macros. One for creating the initial master sheet and one for updating the master sheet. Originally your code had the source sheet starting in row 11, I modified the code to now start a row 1 since this request specified the source starting at row 1. Sub CreateMaster() Set Source = Workbooks("Source.xls") Set SourceSht = Source.Sheets("Sheet1") 'Set SourceSht = Sheets("Sheet1") Set Dest = Workbooks("Destination.xls") 'Set Dest = ThisWorkbook 'create new worksheet With Dest Set DestSht = .Sheets.Add(after:=.Sheets(.Sheets.Count)) DestSht.Name = "Master" End With With DestSht SourceSht.Columns("C:C").Copy _ Destination:=.Columns("C:C") Lastrow = .Range("C" & Rows.Count).End(xlUp).Row .Range("C1:C" & Lastrow).AdvancedFilter _ Action:=xlFilterCopy, _ CopyToRange:=.Range("B1"), _ Unique:=True 'delete temporay column C .Columns("C").Delete .Range("A1") = "SALES" .Range("B1") = "ID" .Range("C1") = "Employee" .Range("D1") = "Hire Date" .Range("E1") = "Manager" .Range("F1") = "Reg" .Range("G1") = "Title" Lastrow = .Range("B" & Rows.Count).End(xlUp).Row For RowCount = 2 To Lastrow ID = .Range("B" & RowCount) With SourceSht Set c = .Columns("C").Find(what:=ID, _ LookIn:=xlValues, lookat:=xlWhole) If c Is Nothing Then MsgBox ("Cannot find ID : " & ID) Else Sales = "N/A" Reg = "N/A" Employee = .Range("A" & c.Row) HireDate = .Range("D" & c.Row) Title = .Range("E" & c.Row) Manager = .Range("G" & c.Row) End If End With If Not c Is Nothing Then .Range("A" & RowCount) = Sales .Range("C" & RowCount) = Employee .Range("D" & RowCount) = HireDate .Range("E" & RowCount) = Manager .Range("F" & RowCount) = Reg .Range("G" & RowCount) = Title Else MsgBox ("Error : Count not find ID : " & ID) End If Next RowCount End With End Sub Sub UpdateMaster() Set Source = Workbooks("Source.xls") Set SourceSht = Source.Sheets("Sheet1") 'Set SourceSht = Sheets("Sheet1") Set Dest = Workbooks("Destination.xls") 'Set Dest = ThisWorkbook Set DestSht = Dest.Sheets("Master") With DestSht Lastrow = .Range("A" & Rows.Count).End(xlUp).Row NewRow = Lastrow + 1 End With With SourceSht Lastrow = .Range("C" & Rows.Count).End(xlUp).Row For RowCount = 2 To Lastrow Sales = "N/A" Reg = "N/A" ID = .Range("C" & RowCount) Employee = .Range("A" & RowCount) HireDate = .Range("D" & RowCount) Title = .Range("E" & RowCount) Manager = .Range("G" & RowCount) With DestSht Set c = .Columns("B").Find(what:=ID, _ LookIn:=xlValues, lookat:=xlWhole) If c Is Nothing Then DataRow = NewRow NewRow = NewRow + 1 .Range("B" & DataRow) = ID Else DataRow = c.Row End If .Range("A" & DataRow) = Sales .Range("C" & DataRow) = Employee .Range("D" & DataRow) = HireDate .Range("E" & DataRow) = Manager .Range("F" & DataRow) = Reg .Range("G" & DataRow) = Title End With Next RowCount End With End Sub "Kanmi" wrote: Sub CreateMaster() Set Source = Workbooks("Source.xls") Set SourceSht = Source.Sheets("Sheet1") Set Dest = Workbooks("Destination.xls") 'create new worksheet With Dest Set DestSht = .Sheets.Add(after:=.Sheets(.Sheets.Count)) End With With DestSht SourceSht.Columns("A:A").Copy _ Destination:=.Columns("D:D") Lastrow = .Range("D" & Rows.Count).End(xlUp).Row .Range("D1:D" & Lastrow).AdvancedFilter _ Action:=xlFilterCopy, _ CopyToRange:=.Range("C11"), _ Unique:=True 'delete temporay column D .Columns("D").Delete .Range("B11") = "MANAGER" .Range("D11") = "ID" Lastrow = .Range("C" & Rows.Count).End(xlUp).Row For RowCount = 12 To Lastrow Employee = .Range("C" & RowCount) With SourceSht Set c = .Columns("A").Find(what:=Employee, _ LookIn:=xlValues, lookat:=xlWhole) If c Is Nothing Then MsgBox ("Cannot find employee : " & Employee) Else Manager = .Range("D" & c.Row) ID = .Range("B" & c.Row) End If End With If Not c Is Nothing Then .Range("B" & RowCount) = Manager .Range("D" & RowCount) = ID End If Next RowCount End With 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 ---------------- -A1:G1 A B C D E F G Employee Login ID ID Hire Date Title Email Manager kim Belly kima 001 06/21/01 MD kim@ Jen kim Belly kima 001 06/21/01 MD kim@ Jen Fue Lee leeo 002 02/07/02 SALES leeo@ Mark Ben Jud bee 003 02/07/02 MD bee@ JEN Yao yu yao 004 02/25/05 MA yao@ Tim- Yao yu yao 004 02/25/05 MA yao@ Tim Yao yu yao 004 02/25/05 MA yao@ Tim DESTINATION.XLS ---------------------- A B C D E F G SALES ID Employee Hire Date Manager Reg Title N/A 001 KIM BELLY 06/21/01 JEN N/A MD N/A 003 BEN JUD 02/07/02 JEN N/A MD N/A 002 FUE LEE 02/07/02 MARK N/A SALES N/A 004 YAO YO 02/25/05 TIM N/A MA This is how the page appeared on each workbook and i have arrange destination.xls the way i want it to work. I want destination.xls automatically pulled update from source.xls and list them according to the manager and even if new students were added then should automatically appear under it manager. I got the VB CODE ABOVE TO EDIT AND SEE OTHER WAYS TO ACHIEVE THIS. I know this might hard to go through but i will appreciate any advice or help because it all chanllenge. Thanks and God bless you. |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Automatic Data Management
Oh you are amazing. Thank you very much. Please i don't want to create a new
sheet in destination.xls. the sheet is already existing, name "WPS Detail Dates" and which workbook will I insert the code. Whenever i put the code in and go back to the excel page nothing happen. Did I need to enable something before it start runing. please explain more. Thanks so much for your help. "Joel" wrote: I wrote 2 macros. One for creating the initial master sheet and one for updating the master sheet. Originally your code had the source sheet starting in row 11, I modified the code to now start a row 1 since this request specified the source starting at row 1. Sub CreateMaster() Set Source = Workbooks("Source.xls") Set SourceSht = Source.Sheets("Sheet1") 'Set SourceSht = Sheets("Sheet1") Set Dest = Workbooks("Destination.xls") 'Set Dest = ThisWorkbook 'create new worksheet With Dest Set DestSht = .Sheets.Add(after:=.Sheets(.Sheets.Count)) DestSht.Name = "Master" End With With DestSht SourceSht.Columns("C:C").Copy _ Destination:=.Columns("C:C") Lastrow = .Range("C" & Rows.Count).End(xlUp).Row .Range("C1:C" & Lastrow).AdvancedFilter _ Action:=xlFilterCopy, _ CopyToRange:=.Range("B1"), _ Unique:=True 'delete temporay column C .Columns("C").Delete .Range("A1") = "SALES" .Range("B1") = "ID" .Range("C1") = "Employee" .Range("D1") = "Hire Date" .Range("E1") = "Manager" .Range("F1") = "Reg" .Range("G1") = "Title" Lastrow = .Range("B" & Rows.Count).End(xlUp).Row For RowCount = 2 To Lastrow ID = .Range("B" & RowCount) With SourceSht Set c = .Columns("C").Find(what:=ID, _ LookIn:=xlValues, lookat:=xlWhole) If c Is Nothing Then MsgBox ("Cannot find ID : " & ID) Else Sales = "N/A" Reg = "N/A" Employee = .Range("A" & c.Row) HireDate = .Range("D" & c.Row) Title = .Range("E" & c.Row) Manager = .Range("G" & c.Row) End If End With If Not c Is Nothing Then .Range("A" & RowCount) = Sales .Range("C" & RowCount) = Employee .Range("D" & RowCount) = HireDate .Range("E" & RowCount) = Manager .Range("F" & RowCount) = Reg .Range("G" & RowCount) = Title Else MsgBox ("Error : Count not find ID : " & ID) End If Next RowCount End With End Sub Sub UpdateMaster() Set Source = Workbooks("Source.xls") Set SourceSht = Source.Sheets("Sheet1") 'Set SourceSht = Sheets("Sheet1") Set Dest = Workbooks("Destination.xls") 'Set Dest = ThisWorkbook Set DestSht = Dest.Sheets("Master") With DestSht Lastrow = .Range("A" & Rows.Count).End(xlUp).Row NewRow = Lastrow + 1 End With With SourceSht Lastrow = .Range("C" & Rows.Count).End(xlUp).Row For RowCount = 2 To Lastrow Sales = "N/A" Reg = "N/A" ID = .Range("C" & RowCount) Employee = .Range("A" & RowCount) HireDate = .Range("D" & RowCount) Title = .Range("E" & RowCount) Manager = .Range("G" & RowCount) With DestSht Set c = .Columns("B").Find(what:=ID, _ LookIn:=xlValues, lookat:=xlWhole) If c Is Nothing Then DataRow = NewRow NewRow = NewRow + 1 .Range("B" & DataRow) = ID Else DataRow = c.Row End If .Range("A" & DataRow) = Sales .Range("C" & DataRow) = Employee .Range("D" & DataRow) = HireDate .Range("E" & DataRow) = Manager .Range("F" & DataRow) = Reg .Range("G" & DataRow) = Title End With Next RowCount End With End Sub "Kanmi" wrote: Sub CreateMaster() Set Source = Workbooks("Source.xls") Set SourceSht = Source.Sheets("Sheet1") Set Dest = Workbooks("Destination.xls") 'create new worksheet With Dest Set DestSht = .Sheets.Add(after:=.Sheets(.Sheets.Count)) End With With DestSht SourceSht.Columns("A:A").Copy _ Destination:=.Columns("D:D") Lastrow = .Range("D" & Rows.Count).End(xlUp).Row .Range("D1:D" & Lastrow).AdvancedFilter _ Action:=xlFilterCopy, _ CopyToRange:=.Range("C11"), _ Unique:=True 'delete temporay column D .Columns("D").Delete .Range("B11") = "MANAGER" .Range("D11") = "ID" Lastrow = .Range("C" & Rows.Count).End(xlUp).Row For RowCount = 12 To Lastrow Employee = .Range("C" & RowCount) With SourceSht Set c = .Columns("A").Find(what:=Employee, _ LookIn:=xlValues, lookat:=xlWhole) If c Is Nothing Then MsgBox ("Cannot find employee : " & Employee) Else Manager = .Range("D" & c.Row) ID = .Range("B" & c.Row) End If End With If Not c Is Nothing Then .Range("B" & RowCount) = Manager .Range("D" & RowCount) = ID End If Next RowCount End With 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 ---------------- -A1:G1 A B C D E F G Employee Login ID ID Hire Date Title Email Manager kim Belly kima 001 06/21/01 MD kim@ Jen kim Belly kima 001 06/21/01 MD kim@ Jen Fue Lee leeo 002 02/07/02 SALES leeo@ Mark Ben Jud bee 003 02/07/02 MD bee@ JEN Yao yu yao 004 02/25/05 MA yao@ Tim- Yao yu yao 004 02/25/05 MA yao@ Tim Yao yu yao 004 02/25/05 MA yao@ Tim DESTINATION.XLS ---------------------- A B C D E F G SALES ID Employee Hire Date Manager Reg Title N/A 001 KIM BELLY 06/21/01 JEN N/A MD N/A 003 BEN JUD 02/07/02 JEN N/A MD N/A 002 FUE LEE 02/07/02 MARK N/A SALES N/A 004 YAO YO 02/25/05 TIM N/A MA This is how the page appeared on each workbook and i have arrange destination.xls the way i want it to work. I want destination.xls automatically pulled update from source.xls and list them according to the manager and even if new students were added then should automatically appear under it manager. I got the VB CODE ABOVE TO EDIT AND SEE OTHER WAYS TO ACHIEVE THIS. I know this might hard to go through but i will appreciate any advice or help because it all chanllenge. Thanks and God bless you. |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Automatic Data Management
I changed the destination worksheet name in the code below. I can add dialog windows so the user can open the workbooks when the macro is running. For the code to 3 workbooks need to be opened 1) the workbook with the macro 2) The source workbook - "Source.xls" 3) the destination workbook - "Destination.xls" Sub CreateMaster() Set Source = Workbooks("Source.xls") Set SourceSht = Source.Sheets("Sheet1") 'Set SourceSht = Sheets("Sheet1") Set Dest = Workbooks("Destination.xls") 'Set Dest = ThisWorkbook 'create new worksheet With Dest DestSht.Name = "WPS Detail Dates" End With With DestSht SourceSht.Columns("C:C").Copy _ Destination:=.Columns("C:C") Lastrow = .Range("C" & Rows.Count).End(xlUp).Row .Range("C1:C" & Lastrow).AdvancedFilter _ Action:=xlFilterCopy, _ CopyToRange:=.Range("B1"), _ Unique:=True 'delete temporay column C .Columns("C").Delete .Range("A1") = "SALES" .Range("B1") = "ID" .Range("C1") = "Employee" .Range("D1") = "Hire Date" .Range("E1") = "Manager" .Range("F1") = "Reg" .Range("G1") = "Title" Lastrow = .Range("B" & Rows.Count).End(xlUp).Row For RowCount = 2 To Lastrow ID = .Range("B" & RowCount) With SourceSht Set c = .Columns("C").Find(what:=ID, _ LookIn:=xlValues, lookat:=xlWhole) If c Is Nothing Then MsgBox ("Cannot find ID : " & ID) Else Sales = "N/A" Reg = "N/A" Employee = .Range("A" & c.Row) HireDate = .Range("D" & c.Row) Title = .Range("E" & c.Row) Manager = .Range("G" & c.Row) End If End With If Not c Is Nothing Then .Range("A" & RowCount) = Sales .Range("C" & RowCount) = Employee .Range("D" & RowCount) = HireDate .Range("E" & RowCount) = Manager .Range("F" & RowCount) = Reg .Range("G" & RowCount) = Title Else MsgBox ("Error : Count not find ID : " & ID) End If Next RowCount End With End Sub Sub UpdateMaster() Set Source = Workbooks("Source.xls") Set SourceSht = Source.Sheets("Sheet1") 'Set SourceSht = Sheets("Sheet1") Set Dest = Workbooks("Destination.xls") 'Set Dest = ThisWorkbook Set DestSht = Dest.Sheets("WPS Detail Dates") With DestSht Lastrow = .Range("A" & Rows.Count).End(xlUp).Row NewRow = Lastrow + 1 End With With SourceSht Lastrow = .Range("C" & Rows.Count).End(xlUp).Row For RowCount = 2 To Lastrow Sales = "N/A" Reg = "N/A" ID = .Range("C" & RowCount) Employee = .Range("A" & RowCount) HireDate = .Range("D" & RowCount) Title = .Range("E" & RowCount) Manager = .Range("G" & RowCount) With DestSht Set c = .Columns("B").Find(what:=ID, _ LookIn:=xlValues, lookat:=xlWhole) If c Is Nothing Then DataRow = NewRow NewRow = NewRow + 1 .Range("B" & DataRow) = ID Else DataRow = c.Row End If .Range("A" & DataRow) = Sales .Range("C" & DataRow) = Employee .Range("D" & DataRow) = HireDate .Range("E" & DataRow) = Manager .Range("F" & DataRow) = Reg .Range("G" & DataRow) = Title End With Next RowCount End With End Sub "Kanmi" wrote: Oh you are amazing. Thank you very much. Please i don't want to create a new sheet in destination.xls. the sheet is already existing, name "WPS Detail Dates" and which workbook will I insert the code. Whenever i put the code in and go back to the excel page nothing happen. Did I need to enable something before it start runing. please explain more. Thanks so much for your help. "Joel" wrote: I wrote 2 macros. One for creating the initial master sheet and one for updating the master sheet. Originally your code had the source sheet starting in row 11, I modified the code to now start a row 1 since this request specified the source starting at row 1. Sub CreateMaster() Set Source = Workbooks("Source.xls") Set SourceSht = Source.Sheets("Sheet1") 'Set SourceSht = Sheets("Sheet1") Set Dest = Workbooks("Destination.xls") 'Set Dest = ThisWorkbook 'create new worksheet With Dest Set DestSht = .Sheets.Add(after:=.Sheets(.Sheets.Count)) DestSht.Name = "Master" End With With DestSht SourceSht.Columns("C:C").Copy _ Destination:=.Columns("C:C") Lastrow = .Range("C" & Rows.Count).End(xlUp).Row .Range("C1:C" & Lastrow).AdvancedFilter _ Action:=xlFilterCopy, _ CopyToRange:=.Range("B1"), _ Unique:=True 'delete temporay column C .Columns("C").Delete .Range("A1") = "SALES" .Range("B1") = "ID" .Range("C1") = "Employee" .Range("D1") = "Hire Date" .Range("E1") = "Manager" .Range("F1") = "Reg" .Range("G1") = "Title" Lastrow = .Range("B" & Rows.Count).End(xlUp).Row For RowCount = 2 To Lastrow ID = .Range("B" & RowCount) With SourceSht Set c = .Columns("C").Find(what:=ID, _ LookIn:=xlValues, lookat:=xlWhole) If c Is Nothing Then MsgBox ("Cannot find ID : " & ID) Else Sales = "N/A" Reg = "N/A" Employee = .Range("A" & c.Row) HireDate = .Range("D" & c.Row) Title = .Range("E" & c.Row) Manager = .Range("G" & c.Row) End If End With If Not c Is Nothing Then .Range("A" & RowCount) = Sales .Range("C" & RowCount) = Employee .Range("D" & RowCount) = HireDate .Range("E" & RowCount) = Manager .Range("F" & RowCount) = Reg .Range("G" & RowCount) = Title Else MsgBox ("Error : Count not find ID : " & ID) End If Next RowCount End With End Sub Sub UpdateMaster() Set Source = Workbooks("Source.xls") Set SourceSht = Source.Sheets("Sheet1") 'Set SourceSht = Sheets("Sheet1") Set Dest = Workbooks("Destination.xls") 'Set Dest = ThisWorkbook Set DestSht = Dest.Sheets("Master") With DestSht Lastrow = .Range("A" & Rows.Count).End(xlUp).Row NewRow = Lastrow + 1 End With With SourceSht Lastrow = .Range("C" & Rows.Count).End(xlUp).Row For RowCount = 2 To Lastrow Sales = "N/A" Reg = "N/A" ID = .Range("C" & RowCount) Employee = .Range("A" & RowCount) HireDate = .Range("D" & RowCount) Title = .Range("E" & RowCount) Manager = .Range("G" & RowCount) With DestSht Set c = .Columns("B").Find(what:=ID, _ LookIn:=xlValues, lookat:=xlWhole) If c Is Nothing Then DataRow = NewRow NewRow = NewRow + 1 .Range("B" & DataRow) = ID Else DataRow = c.Row End If .Range("A" & DataRow) = Sales .Range("C" & DataRow) = Employee .Range("D" & DataRow) = HireDate .Range("E" & DataRow) = Manager .Range("F" & DataRow) = Reg .Range("G" & DataRow) = Title End With Next RowCount End With End Sub "Kanmi" wrote: Sub CreateMaster() Set Source = Workbooks("Source.xls") Set SourceSht = Source.Sheets("Sheet1") Set Dest = Workbooks("Destination.xls") 'create new worksheet With Dest Set DestSht = .Sheets.Add(after:=.Sheets(.Sheets.Count)) End With With DestSht SourceSht.Columns("A:A").Copy _ Destination:=.Columns("D:D") Lastrow = .Range("D" & Rows.Count).End(xlUp).Row .Range("D1:D" & Lastrow).AdvancedFilter _ Action:=xlFilterCopy, _ CopyToRange:=.Range("C11"), _ Unique:=True 'delete temporay column D .Columns("D").Delete .Range("B11") = "MANAGER" .Range("D11") = "ID" Lastrow = .Range("C" & Rows.Count).End(xlUp).Row For RowCount = 12 To Lastrow Employee = .Range("C" & RowCount) With SourceSht Set c = .Columns("A").Find(what:=Employee, _ LookIn:=xlValues, lookat:=xlWhole) If c Is Nothing Then MsgBox ("Cannot find employee : " & Employee) Else Manager = .Range("D" & c.Row) ID = .Range("B" & c.Row) End If End With If Not c Is Nothing Then .Range("B" & RowCount) = Manager .Range("D" & RowCount) = ID End If Next RowCount End With 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 ---------------- -A1:G1 A B C D E F G Employee Login ID ID Hire Date Title Email Manager kim Belly kima 001 06/21/01 MD kim@ Jen kim Belly kima 001 06/21/01 MD kim@ Jen Fue Lee leeo 002 02/07/02 SALES leeo@ Mark Ben Jud bee 003 02/07/02 MD bee@ JEN Yao yu yao 004 02/25/05 MA yao@ Tim- Yao yu yao 004 02/25/05 MA yao@ Tim Yao yu yao 004 02/25/05 MA yao@ Tim DESTINATION.XLS ---------------------- A B C D E F G SALES ID Employee Hire Date Manager Reg Title N/A 001 KIM BELLY 06/21/01 JEN N/A MD N/A 003 BEN JUD 02/07/02 JEN N/A MD N/A 002 FUE LEE 02/07/02 MARK N/A SALES N/A 004 YAO YO 02/25/05 TIM N/A MA This is how the page appeared on each workbook and i have arrange destination.xls the way i want it to work. I want destination.xls automatically pulled update from source.xls and list them according to the manager and even if new students were added then should automatically appear under it manager. I got the VB CODE ABOVE TO EDIT AND SEE OTHER WAYS TO ACHIEVE THIS. I know this might hard to go through but i will appreciate any advice or help because it all chanllenge. Thanks and God bless you. |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
Automatic Data Management
Hello Joel. You are Amazing!. Thanks alot. The scripts below is working but is creating a new master "sheet". No there is existing sheet name "WPS Detail Dates" which i want the information to appear.I want skip or exclude rows A and F (N/A). I don't the scripts to affect them" They showing N/A" I want to free those rows. NOTE. I tried to edit it not to create new master sheet and insert the information in sheet "WPS Detail Dates" but it showing ERROR " RUN-TIME ERROR 424" OBJECT REQUIRED. So please help me look into it. Thanks alot. "Joel" wrote: I changed the destination worksheet name in the code below. I can add dialog windows so the user can open the workbooks when the macro is running. For the code to 3 workbooks need to be opened 1) the workbook with the macro 2) The source workbook - "Source.xls" 3) the destination workbook - "Destination.xls" Sub CreateMaster() Set Source = Workbooks("Source.xls") Set SourceSht = Source.Sheets("Sheet1") 'Set SourceSht = Sheets("Sheet1") Set Dest = Workbooks("Destination.xls") 'Set Dest = ThisWorkbook 'create new worksheet With Dest DestSht.Name = "WPS Detail Dates" End With With DestSht SourceSht.Columns("C:C").Copy _ Destination:=.Columns("C:C") Lastrow = .Range("C" & Rows.Count).End(xlUp).Row .Range("C1:C" & Lastrow).AdvancedFilter _ Action:=xlFilterCopy, _ CopyToRange:=.Range("B1"), _ Unique:=True 'delete temporay column C .Columns("C").Delete .Range("A1") = "SALES" .Range("B1") = "ID" .Range("C1") = "Employee" .Range("D1") = "Hire Date" .Range("E1") = "Manager" .Range("F1") = "Reg" .Range("G1") = "Title" Lastrow = .Range("B" & Rows.Count).End(xlUp).Row For RowCount = 2 To Lastrow ID = .Range("B" & RowCount) With SourceSht Set c = .Columns("C").Find(what:=ID, _ LookIn:=xlValues, lookat:=xlWhole) If c Is Nothing Then MsgBox ("Cannot find ID : " & ID) Else Sales = "N/A" Reg = "N/A" Employee = .Range("A" & c.Row) HireDate = .Range("D" & c.Row) Title = .Range("E" & c.Row) Manager = .Range("G" & c.Row) End If End With If Not c Is Nothing Then .Range("A" & RowCount) = Sales .Range("C" & RowCount) = Employee .Range("D" & RowCount) = HireDate .Range("E" & RowCount) = Manager .Range("F" & RowCount) = Reg .Range("G" & RowCount) = Title Else MsgBox ("Error : Count not find ID : " & ID) End If Next RowCount End With End Sub Sub UpdateMaster() Set Source = Workbooks("Source.xls") Set SourceSht = Source.Sheets("Sheet1") 'Set SourceSht = Sheets("Sheet1") Set Dest = Workbooks("Destination.xls") 'Set Dest = ThisWorkbook Set DestSht = Dest.Sheets("WPS Detail Dates") With DestSht Lastrow = .Range("A" & Rows.Count).End(xlUp).Row NewRow = Lastrow + 1 End With With SourceSht Lastrow = .Range("C" & Rows.Count).End(xlUp).Row For RowCount = 2 To Lastrow Sales = "N/A" Reg = "N/A" ID = .Range("C" & RowCount) Employee = .Range("A" & RowCount) HireDate = .Range("D" & RowCount) Title = .Range("E" & RowCount) Manager = .Range("G" & RowCount) With DestSht Set c = .Columns("B").Find(what:=ID, _ LookIn:=xlValues, lookat:=xlWhole) If c Is Nothing Then DataRow = NewRow NewRow = NewRow + 1 .Range("B" & DataRow) = ID Else DataRow = c.Row End If .Range("A" & DataRow) = Sales .Range("C" & DataRow) = Employee .Range("D" & DataRow) = HireDate .Range("E" & DataRow) = Manager .Range("F" & DataRow) = Reg .Range("G" & DataRow) = Title End With Next RowCount End With End Sub "Kanmi" wrote: Oh you are amazing. Thank you very much. Please i don't want to create a new sheet in destination.xls. the sheet is already existing, name "WPS Detail Dates" and which workbook will I insert the code. Whenever i put the code in and go back to the excel page nothing happen. Did I need to enable something before it start runing. please explain more. Thanks so much for your help. "Joel" wrote: I wrote 2 macros. One for creating the initial master sheet and one for updating the master sheet. Originally your code had the source sheet starting in row 11, I modified the code to now start a row 1 since this request specified the source starting at row 1. Sub CreateMaster() Set Source = Workbooks("Source.xls") Set SourceSht = Source.Sheets("Sheet1") 'Set SourceSht = Sheets("Sheet1") Set Dest = Workbooks("Destination.xls") 'Set Dest = ThisWorkbook 'create new worksheet With Dest Set DestSht = .Sheets.Add(after:=.Sheets(.Sheets.Count)) DestSht.Name = "Master" End With With DestSht SourceSht.Columns("C:C").Copy _ Destination:=.Columns("C:C") Lastrow = .Range("C" & Rows.Count).End(xlUp).Row .Range("C1:C" & Lastrow).AdvancedFilter _ Action:=xlFilterCopy, _ CopyToRange:=.Range("B1"), _ Unique:=True 'delete temporay column C .Columns("C").Delete .Range("A1") = "SALES" .Range("B1") = "ID" .Range("C1") = "Employee" .Range("D1") = "Hire Date" .Range("E1") = "Manager" .Range("F1") = "Reg" .Range("G1") = "Title" Lastrow = .Range("B" & Rows.Count).End(xlUp).Row For RowCount = 2 To Lastrow ID = .Range("B" & RowCount) With SourceSht Set c = .Columns("C").Find(what:=ID, _ LookIn:=xlValues, lookat:=xlWhole) If c Is Nothing Then MsgBox ("Cannot find ID : " & ID) Else Sales = "N/A" Reg = "N/A" Employee = .Range("A" & c.Row) HireDate = .Range("D" & c.Row) Title = .Range("E" & c.Row) Manager = .Range("G" & c.Row) End If End With If Not c Is Nothing Then .Range("A" & RowCount) = Sales .Range("C" & RowCount) = Employee .Range("D" & RowCount) = HireDate .Range("E" & RowCount) = Manager .Range("F" & RowCount) = Reg .Range("G" & RowCount) = Title Else MsgBox ("Error : Count not find ID : " & ID) End If Next RowCount End With End Sub Sub UpdateMaster() Set Source = Workbooks("Source.xls") Set SourceSht = Source.Sheets("Sheet1") 'Set SourceSht = Sheets("Sheet1") Set Dest = Workbooks("Destination.xls") 'Set Dest = ThisWorkbook Set DestSht = Dest.Sheets("Master") With DestSht Lastrow = .Range("A" & Rows.Count).End(xlUp).Row NewRow = Lastrow + 1 End With With SourceSht Lastrow = .Range("C" & Rows.Count).End(xlUp).Row For RowCount = 2 To Lastrow Sales = "N/A" Reg = "N/A" ID = .Range("C" & RowCount) Employee = .Range("A" & RowCount) HireDate = .Range("D" & RowCount) Title = .Range("E" & RowCount) Manager = .Range("G" & RowCount) With DestSht Set c = .Columns("B").Find(what:=ID, _ LookIn:=xlValues, lookat:=xlWhole) If c Is Nothing Then DataRow = NewRow NewRow = NewRow + 1 .Range("B" & DataRow) = ID Else DataRow = c.Row End If .Range("A" & DataRow) = Sales .Range("C" & DataRow) = Employee .Range("D" & DataRow) = HireDate .Range("E" & DataRow) = Manager .Range("F" & DataRow) = Reg .Range("G" & DataRow) = Title End With Next RowCount End With End Sub "Kanmi" wrote: Sub CreateMaster() Set Source = Workbooks("Source.xls") Set SourceSht = Source.Sheets("Sheet1") Set Dest = Workbooks("Destination.xls") 'create new worksheet With Dest Set DestSht = .Sheets.Add(after:=.Sheets(.Sheets.Count)) End With With DestSht SourceSht.Columns("A:A").Copy _ Destination:=.Columns("D:D") Lastrow = .Range("D" & Rows.Count).End(xlUp).Row .Range("D1:D" & Lastrow).AdvancedFilter _ Action:=xlFilterCopy, _ CopyToRange:=.Range("C11"), _ Unique:=True 'delete temporay column D .Columns("D").Delete .Range("B11") = "MANAGER" .Range("D11") = "ID" Lastrow = .Range("C" & Rows.Count).End(xlUp).Row For RowCount = 12 To Lastrow Employee = .Range("C" & RowCount) With SourceSht Set c = .Columns("A").Find(what:=Employee, _ LookIn:=xlValues, lookat:=xlWhole) If c Is Nothing Then |
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
Automatic Data Management
Hello Joel. You are Amazing!. Thanks alot. The scripts below is working but is creating a new master "sheet". No there is existing sheet name "WPS Detail Dates" which i want the information to appear.I want skip or exclude rows A and F (N/A). I don't the scripts to affect them" They showing N/A" I want to free those rows. NOTE. I tried to edit it not to create new master sheet and insert the information in sheet "WPS Detail Dates" but it showing ERROR " RUN-TIME ERROR 424" OBJECT REQUIRED. So please help me look into it. Thanks alot. Sub CreateMaster() Set Source = Workbooks("Source.xls") Set SourceSht = Source.Sheets("Sheet1") 'Set SourceSht = Sheets("Sheet1") Set Dest = Workbooks("Destination.xls") 'Set Dest = ThisWorkbook 'create new worksheet With Dest Set DestSht = .Sheets.Add(after:=.Sheets(.Sheets.Count)) DestSht.Name = "Master" End With With DestSht SourceSht.Columns("C:C").Copy _ Destination:=.Columns("C:C") Lastrow = .Range("C" & Rows.Count).End(xlUp).Row .Range("C1:C" & Lastrow).AdvancedFilter _ Action:=xlFilterCopy, _ CopyToRange:=.Range("B1"), _ Unique:=True 'delete temporay column C .Columns("C").Delete .Range("A1") = "SALES" .Range("B1") = "ID" .Range("C1") = "Employee" .Range("D1") = "Hire Date" .Range("E1") = "Manager" .Range("F1") = "Reg" .Range("G1") = "Title" Lastrow = .Range("B" & Rows.Count).End(xlUp).Row For RowCount = 2 To Lastrow ID = .Range("B" & RowCount) With SourceSht Set c = .Columns("C").Find(what:=ID, _ LookIn:=xlValues, lookat:=xlWhole) If c Is Nothing Then MsgBox ("Cannot find ID : " & ID) Else Sales = "N/A" Reg = "N/A" Employee = .Range("A" & c.Row) HireDate = .Range("D" & c.Row) Title = .Range("E" & c.Row) Manager = .Range("G" & c.Row) End If End With If Not c Is Nothing Then .Range("A" & RowCount) = Sales .Range("C" & RowCount) = Employee .Range("D" & RowCount) = HireDate .Range("E" & RowCount) = Manager .Range("F" & RowCount) = Reg .Range("G" & RowCount) = Title Else MsgBox ("Error : Count not find ID : " & ID) End If Next RowCount End With End Sub Sub UpdateMaster() Set Source = Workbooks("Source.xls") Set SourceSht = Source.Sheets("Sheet1") 'Set SourceSht = Sheets("Sheet1") Set Dest = Workbooks("Destination.xls") 'Set Dest = ThisWorkbook Set DestSht = Dest.Sheets("Master") With DestSht Lastrow = .Range("A" & Rows.Count).End(xlUp).Row NewRow = Lastrow + 1 End With With SourceSht Lastrow = .Range("C" & Rows.Count).End(xlUp).Row For RowCount = 2 To Lastrow Sales = "N/A" Reg = "N/A" ID = .Range("C" & RowCount) Employee = .Range("A" & RowCount) HireDate = .Range("D" & RowCount) Title = .Range("E" & RowCount) Manager = .Range("G" & RowCount) With DestSht Set c = .Columns("B").Find(what:=ID, _ LookIn:=xlValues, lookat:=xlWhole) If c Is Nothing Then DataRow = NewRow NewRow = NewRow + 1 .Range("B" & DataRow) = ID Else DataRow = c.Row End If .Range("A" & DataRow) = Sales .Range("C" & DataRow) = Employee .Range("D" & DataRow) = HireDate .Range("E" & DataRow) = Manager .Range("F" & DataRow) = Reg .Range("G" & DataRow) = Title End With Next RowCount End With End Sub "Kanmi" wrote: Hello Joel. You are Amazing!. Thanks alot. The scripts below is working but is creating a new master "sheet". No there is existing sheet name "WPS Detail Dates" which i want the information to appear.I want skip or exclude rows A and F (N/A). I don't the scripts to affect them" They showing N/A" I want to free those rows. NOTE. I tried to edit it not to create new master sheet and insert the information in sheet "WPS Detail Dates" but it showing ERROR " RUN-TIME ERROR 424" OBJECT REQUIRED. So please help me look into it. Thanks alot. "Joel" wrote: I changed the destination worksheet name in the code below. I can add dialog windows so the user can open the workbooks when the macro is running. For the code to 3 workbooks need to be opened 1) the workbook with the macro 2) The source workbook - "Source.xls" 3) the destination workbook - "Destination.xls" Sub CreateMaster() Set Source = Workbooks("Source.xls") Set SourceSht = Source.Sheets("Sheet1") 'Set SourceSht = Sheets("Sheet1") Set Dest = Workbooks("Destination.xls") 'Set Dest = ThisWorkbook 'create new worksheet With Dest DestSht.Name = "WPS Detail Dates" End With With DestSht SourceSht.Columns("C:C").Copy _ Destination:=.Columns("C:C") Lastrow = .Range("C" & Rows.Count).End(xlUp).Row .Range("C1:C" & Lastrow).AdvancedFilter _ Action:=xlFilterCopy, _ CopyToRange:=.Range("B1"), _ Unique:=True 'delete temporay column C .Columns("C").Delete .Range("A1") = "SALES" .Range("B1") = "ID" .Range("C1") = "Employee" .Range("D1") = "Hire Date" .Range("E1") = "Manager" .Range("F1") = "Reg" .Range("G1") = "Title" Lastrow = .Range("B" & Rows.Count).End(xlUp).Row For RowCount = 2 To Lastrow ID = .Range("B" & RowCount) With SourceSht Set c = .Columns("C").Find(what:=ID, _ LookIn:=xlValues, lookat:=xlWhole) If c Is Nothing Then MsgBox ("Cannot find ID : " & ID) Else Sales = "N/A" Reg = "N/A" Employee = .Range("A" & c.Row) HireDate = .Range("D" & c.Row) Title = .Range("E" & c.Row) Manager = .Range("G" & c.Row) End If End With If Not c Is Nothing Then .Range("A" & RowCount) = Sales .Range("C" & RowCount) = Employee .Range("D" & RowCount) = HireDate .Range("E" & RowCount) = Manager .Range("F" & RowCount) = Reg .Range("G" & RowCount) = Title Else MsgBox ("Error : Count not find ID : " & ID) End If Next RowCount End With End Sub Sub UpdateMaster() Set Source = Workbooks("Source.xls") Set SourceSht = Source.Sheets("Sheet1") 'Set SourceSht = Sheets("Sheet1") Set Dest = Workbooks("Destination.xls") 'Set Dest = ThisWorkbook Set DestSht = Dest.Sheets("WPS Detail Dates") With DestSht Lastrow = .Range("A" & Rows.Count).End(xlUp).Row NewRow = Lastrow + 1 End With With SourceSht Lastrow = .Range("C" & Rows.Count).End(xlUp).Row For RowCount = 2 To Lastrow Sales = "N/A" Reg = "N/A" ID = .Range("C" & RowCount) Employee = .Range("A" & RowCount) HireDate = .Range("D" & RowCount) Title = .Range("E" & RowCount) Manager = .Range("G" & RowCount) With DestSht Set c = .Columns("B").Find(what:=ID, _ LookIn:=xlValues, lookat:=xlWhole) If c Is Nothing Then DataRow = NewRow NewRow = NewRow + 1 .Range("B" & DataRow) = ID Else DataRow = c.Row End If .Range("A" & DataRow) = Sales .Range("C" & DataRow) = Employee .Range("D" & DataRow) = HireDate .Range("E" & DataRow) = Manager .Range("F" & DataRow) = Reg .Range("G" & DataRow) = Title End With Next RowCount End With End Sub "Kanmi" wrote: Oh you are amazing. Thank you very much. Please i don't want to create a new sheet in destination.xls. the sheet is already existing, name "WPS Detail Dates" and which workbook will I insert the code. Whenever i put the code in and go back to the excel page nothing happen. Did I need to enable something before it start runing. please explain more. Thanks so much for your help. "Joel" wrote: I wrote 2 macros. One for creating the initial master sheet and one for updating the master sheet. Originally your code had the source sheet starting in row 11, I modified the code to now start a row 1 since this request specified the source starting at row 1. Sub CreateMaster() Set Source = Workbooks("Source.xls") Set SourceSht = Source.Sheets("Sheet1") 'Set SourceSht = Sheets("Sheet1") Set Dest = Workbooks("Destination.xls") 'Set Dest = ThisWorkbook 'create new worksheet With Dest Set DestSht = .Sheets.Add(after:=.Sheets(.Sheets.Count)) DestSht.Name = "Master" End With With DestSht SourceSht.Columns("C:C").Copy _ Destination:=.Columns("C:C") Lastrow = .Range("C" & Rows.Count).End(xlUp).Row .Range("C1:C" & Lastrow).AdvancedFilter _ Action:=xlFilterCopy, _ CopyToRange:=.Range("B1"), _ Unique:=True 'delete temporay column C .Columns("C").Delete .Range("A1") = "SALES" .Range("B1") = "ID" .Range("C1") = "Employee" .Range("D1") = "Hire Date" .Range("E1") = "Manager" .Range("F1") = "Reg" .Range("G1") = "Title" Lastrow = .Range("B" & Rows.Count).End(xlUp).Row For RowCount = 2 To Lastrow ID = .Range("B" & RowCount) With SourceSht Set c = .Columns("C").Find(what:=ID, _ LookIn:=xlValues, lookat:=xlWhole) If c Is Nothing Then MsgBox ("Cannot find ID : " & ID) Else Sales = "N/A" Reg = "N/A" Employee = .Range("A" & c.Row) HireDate = .Range("D" & c.Row) Title = .Range("E" & c.Row) Manager = .Range("G" & c.Row) End If End With If Not c Is Nothing Then .Range("A" & RowCount) = Sales .Range("C" & RowCount) = Employee .Range("D" & RowCount) = HireDate .Range("E" & RowCount) = Manager .Range("F" & RowCount) = Reg .Range("G" & RowCount) = Title Else MsgBox ("Error : Count not find ID : " & ID) End If Next RowCount End With End Sub Sub UpdateMaster() Set Source = Workbooks("Source.xls") Set SourceSht = Source.Sheets("Sheet1") 'Set SourceSht = Sheets("Sheet1") Set Dest = Workbooks("Destination.xls") 'Set Dest = ThisWorkbook Set DestSht = Dest.Sheets("Master") With DestSht Lastrow = .Range("A" & Rows.Count).End(xlUp).Row NewRow = Lastrow + 1 End With With SourceSht Lastrow = .Range("C" & Rows.Count).End(xlUp).Row For RowCount = 2 To Lastrow Sales = "N/A" Reg = "N/A" ID = .Range("C" & RowCount) Employee = .Range("A" & RowCount) HireDate = .Range("D" & RowCount) Title = .Range("E" & RowCount) Manager = .Range("G" & RowCount) With DestSht Set c = .Columns("B").Find(what:=ID, _ LookIn:=xlValues, lookat:=xlWhole) If c Is Nothing Then DataRow = NewRow NewRow = NewRow + 1 .Range("B" & DataRow) = ID Else DataRow = c.Row End If .Range("A" & DataRow) = Sales .Range("C" & DataRow) = Employee .Range("D" & DataRow) = HireDate .Range("E" & DataRow) = Manager .Range("F" & DataRow) = Reg .Range("G" & DataRow) = Title End With Next RowCount End With End Sub "Kanmi" wrote: Sub CreateMaster() Set Source = Workbooks("Source.xls") Set SourceSht = Source.Sheets("Sheet1") Set Dest = Workbooks("Destination.xls") 'create new worksheet With Dest Set DestSht = .Sheets.Add(after:=.Sheets(.Sheets.Count)) End With With DestSht SourceSht.Columns("A:A").Copy _ Destination:=.Columns("D:D") Lastrow = .Range("D" & Rows.Count).End(xlUp).Row .Range("D1:D" & Lastrow).AdvancedFilter _ Action:=xlFilterCopy, _ CopyToRange:=.Range("C11"), _ Unique:=True 'delete temporay column D .Columns("D").Delete |
#8
Posted to microsoft.public.excel.programming
|
|||
|
|||
Automatic Data Management
There are two macros in the code I sent. the 1st one is intended for a new data and the second is for updating an existing workbook. The 2nd should work in either case. You should be running the 2nd macro. I made one change to the 1st macro to clear all cells in destination sheet assuming you want to add all data. I changed the 2nd macro to test for N/A in columns A and F. Sub CreateMaster() SourceToOpen = Application _ .GetOpenFilename(FileFilter:="Excel Files (*.xls), *.xls", _ Title:="Select Source file") If SourceToOpen = False Then MsgBox ("Cannot Open file - Exinting Macro") Exit Sub End If DestToOpen = Application _ .GetOpenFilename(FileFilter:="Excel Files (*.xls), *.xls", _ Title:="Select Destination file") If DestToOpen = False Then MsgBox ("Cannot Open file - Exinting Macro") Exit Sub End If Set Source = Workbooks.Open(Filename:=SourceToOpen) Set SourceSht = Source.Sheets("Sheet1") 'Set SourceSht = Sheets("Sheet1") Set Dest = Workbooks.Open(Filename:=DestToOpen) 'Set Dest = ThisWorkbook Set DestSht = Dest.Sheets("WPS Detail Dates") With DestSht .Cells.ClearContents SourceSht.Columns("C:C").Copy _ Destination:=.Columns("C:C") Lastrow = .Range("C" & Rows.Count).End(xlUp).Row .Range("C1:C" & Lastrow).AdvancedFilter _ Action:=xlFilterCopy, _ CopyToRange:=.Range("B1"), _ Unique:=True 'delete temporay column C .Columns("C").Delete .Range("A1") = "SALES" .Range("B1") = "ID" .Range("C1") = "Employee" .Range("D1") = "Hire Date" .Range("E1") = "Manager" .Range("F1") = "Reg" .Range("G1") = "Title" Lastrow = .Range("B" & Rows.Count).End(xlUp).Row For RowCount = 2 To Lastrow ID = .Range("B" & RowCount) With SourceSht Set c = .Columns("C").Find(what:=ID, _ LookIn:=xlValues, lookat:=xlWhole) If c Is Nothing Then MsgBox ("Cannot find ID : " & ID) Else Sales = "N/A" Reg = "N/A" Employee = .Range("A" & c.Row) HireDate = .Range("D" & c.Row) Title = .Range("E" & c.Row) Manager = .Range("G" & c.Row) End If End With If Not c Is Nothing Then .Range("A" & RowCount) = Sales .Range("C" & RowCount) = Employee .Range("D" & RowCount) = HireDate .Range("E" & RowCount) = Manager .Range("F" & RowCount) = Reg .Range("G" & RowCount) = Title Else MsgBox ("Error : Count not find ID : " & ID) End If Next RowCount End With End Sub Sub UpdateMaster() SourceToOpen = Application _ .GetOpenFilename(FileFilter:="Excel Files (*.xls), *.xls", _ Title:="Select Source file") If SourceToOpen = False Then MsgBox ("Cannot Open file - Exinting Macro") Exit Sub End If DestToOpen = Application _ .GetOpenFilename(FileFilter:="Excel Files (*.xls), *.xls", _ Title:="Select Destination file") If DestToOpen = False Then MsgBox ("Cannot Open file - Exinting Macro") Exit Sub End If Set Source = Workbooks.Open(Filename:=SourceToOpen) Set SourceSht = Source.Sheets("Sheet1") 'Set SourceSht = Sheets("Sheet1") Set Dest = Workbooks.Open(Filename:=DestToOpen) 'Set Dest = ThisWorkbook Set DestSht = Dest.Sheets("WPS Detail Dates") With DestSht Lastrow = .Range("A" & Rows.Count).End(xlUp).Row NewRow = Lastrow + 1 End With With SourceSht Lastrow = .Range("C" & Rows.Count).End(xlUp).Row For RowCount = 2 To Lastrow ID = .Range("C" & RowCount) Employee = .Range("A" & RowCount) HireDate = .Range("D" & RowCount) Title = .Range("E" & RowCount) Manager = .Range("G" & RowCount) With DestSht Set c = .Columns("B").Find(what:=ID, _ LookIn:=xlValues, lookat:=xlWhole) If c Is Nothing Then DataRow = NewRow NewRow = NewRow + 1 .Range("B" & DataRow) = ID .Range("C" & DataRow) = Employee .Range("D" & DataRow) = HireDate .Range("E" & DataRow) = Manager .Range("F" & DataRow) = Reg Else DataRow = c.Row If .Range("A" & DataRow) < "N/A" And _ .Range("F" & DataRow) < "N/A" Then .Range("C" & DataRow) = Employee .Range("D" & DataRow) = HireDate .Range("E" & DataRow) = Manager .Range("G" & DataRow) = Title End If End If End With Next RowCount End With End Sub |
#9
Posted to microsoft.public.excel.programming
|
|||
|
|||
Automatic Data Management
Thanks alot. You've being so helpful. Whenever I run this it just pop up empty vb code screen. please these link for the file then you will understand what i'm talking about. i will appreciate if we can talk back to back and do it together. http://www.4shared.com/file/11638244...6f/source.html http://www.4shared.com/file/11638259...stination.html Please help me check the links and see if we talk back to back to resolve it. I don't know how i can thank you for this. You are so helpful. Thanks "Joel" wrote: There are two macros in the code I sent. the 1st one is intended for a new data and the second is for updating an existing workbook. The 2nd should work in either case. You should be running the 2nd macro. I made one change to the 1st macro to clear all cells in destination sheet assuming you want to add all data. I changed the 2nd macro to test for N/A in columns A and F. Sub CreateMaster() SourceToOpen = Application _ .GetOpenFilename(FileFilter:="Excel Files (*.xls), *.xls", _ Title:="Select Source file") If SourceToOpen = False Then MsgBox ("Cannot Open file - Exinting Macro") Exit Sub End If DestToOpen = Application _ .GetOpenFilename(FileFilter:="Excel Files (*.xls), *.xls", _ Title:="Select Destination file") If DestToOpen = False Then MsgBox ("Cannot Open file - Exinting Macro") Exit Sub End If Set Source = Workbooks.Open(Filename:=SourceToOpen) Set SourceSht = Source.Sheets("Sheet1") 'Set SourceSht = Sheets("Sheet1") Set Dest = Workbooks.Open(Filename:=DestToOpen) 'Set Dest = ThisWorkbook Set DestSht = Dest.Sheets("WPS Detail Dates") With DestSht .Cells.ClearContents SourceSht.Columns("C:C").Copy _ Destination:=.Columns("C:C") Lastrow = .Range("C" & Rows.Count).End(xlUp).Row .Range("C1:C" & Lastrow).AdvancedFilter _ Action:=xlFilterCopy, _ CopyToRange:=.Range("B1"), _ Unique:=True 'delete temporay column C .Columns("C").Delete .Range("A1") = "SALES" .Range("B1") = "ID" .Range("C1") = "Employee" .Range("D1") = "Hire Date" .Range("E1") = "Manager" .Range("F1") = "Reg" .Range("G1") = "Title" Lastrow = .Range("B" & Rows.Count).End(xlUp).Row For RowCount = 2 To Lastrow ID = .Range("B" & RowCount) With SourceSht Set c = .Columns("C").Find(what:=ID, _ LookIn:=xlValues, lookat:=xlWhole) If c Is Nothing Then MsgBox ("Cannot find ID : " & ID) Else Sales = "N/A" Reg = "N/A" Employee = .Range("A" & c.Row) HireDate = .Range("D" & c.Row) Title = .Range("E" & c.Row) Manager = .Range("G" & c.Row) End If End With If Not c Is Nothing Then .Range("A" & RowCount) = Sales .Range("C" & RowCount) = Employee .Range("D" & RowCount) = HireDate .Range("E" & RowCount) = Manager .Range("F" & RowCount) = Reg .Range("G" & RowCount) = Title Else MsgBox ("Error : Count not find ID : " & ID) End If Next RowCount End With End Sub Sub UpdateMaster() SourceToOpen = Application _ .GetOpenFilename(FileFilter:="Excel Files (*.xls), *.xls", _ Title:="Select Source file") If SourceToOpen = False Then MsgBox ("Cannot Open file - Exinting Macro") Exit Sub End If DestToOpen = Application _ .GetOpenFilename(FileFilter:="Excel Files (*.xls), *.xls", _ Title:="Select Destination file") If DestToOpen = False Then MsgBox ("Cannot Open file - Exinting Macro") Exit Sub End If Set Source = Workbooks.Open(Filename:=SourceToOpen) Set SourceSht = Source.Sheets("Sheet1") 'Set SourceSht = Sheets("Sheet1") Set Dest = Workbooks.Open(Filename:=DestToOpen) 'Set Dest = ThisWorkbook Set DestSht = Dest.Sheets("WPS Detail Dates") With DestSht Lastrow = .Range("A" & Rows.Count).End(xlUp).Row NewRow = Lastrow + 1 End With With SourceSht Lastrow = .Range("C" & Rows.Count).End(xlUp).Row For RowCount = 2 To Lastrow ID = .Range("C" & RowCount) Employee = .Range("A" & RowCount) HireDate = .Range("D" & RowCount) Title = .Range("E" & RowCount) Manager = .Range("G" & RowCount) With DestSht Set c = .Columns("B").Find(what:=ID, _ LookIn:=xlValues, lookat:=xlWhole) If c Is Nothing Then DataRow = NewRow NewRow = NewRow + 1 .Range("B" & DataRow) = ID .Range("C" & DataRow) = Employee .Range("D" & DataRow) = HireDate .Range("E" & DataRow) = Manager .Range("F" & DataRow) = Reg Else DataRow = c.Row If .Range("A" & DataRow) < "N/A" And _ .Range("F" & DataRow) < "N/A" Then .Range("C" & DataRow) = Employee .Range("D" & DataRow) = HireDate .Range("E" & DataRow) = Manager .Range("G" & DataRow) = Title End If End If End With Next RowCount End With End Sub |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
cell data management | Excel Discussion (Misc queries) | |||
Data Management | Excel Discussion (Misc queries) | |||
Data management | Excel Discussion (Misc queries) | |||
Data management error? | Excel Programming | |||
Data management for csv file | Excel Programming |