Hi. I am in need of a macro or formula that will copy an entire row over to another worksheet based on a specific value. For instance. I have the below table:…….
Hi Michelle,
.. I changed your data to make the Macro I wrote for you a bit easier to test:
| Book1 |
|---|
|
|---|
| A | B | C | D | E | F | G | H | I | J | K | L |
|---|
| 1 | P | C | R | Device # | Location Address | Test Date | AOC Due Date | Third Party Witness | Elevator Part | Violation Condition | Suggested Remedy | Classification (Building, Billable,
Maintenance, Repair) |
|---|
| 2 | 6 | B | 1 | 2W12080 | 231 W. 246th ST, Bronx | 8/21/2012 | 11/13/2012 | Lift - Tech LTD | Car Door/Gate Contact | Insufficent | Adjust | Maintenance |
|---|
| 3 | 21 | B | 1 | 2W12080 | 231 W. 246th ST, Bronx | 8/21/2012 | 11/13/2012 | Lift - Tech LTD | Interlocks | Insufficent | Adjust | Maintenance |
|---|
| 4 | 5 | J | 1 | 2P10193 | 231 W. 246th ST, Bronx | 8/21/2012 | 11/13/2012 | Lift - Tech LTD | Car Door/Gate | Misaligned | Adjust | Repair |
|---|
| 5 | 69 | M | 7 | 2P10193 | 231 W. 246th ST, Bronx | 8/21/2012 | 11/13/2012 | Lift - Tech LTD | Code Data Plate | Missing | Provide | Billable |
|---|
| 6 | 1 | c | 2 | 414 | 232 | 8/21/2012 | 11/13/2012 | Lift - Tech LTD | a | fa | hz | Building |
|---|
| 7 | 2 | d | 4 | 415 | 233 | 8/21/2012 | 11/13/2012 | Lift - Tech LTD | b | asfgg | aaad | Repair |
|---|
| 8 | 3 | e | 6 | 416 | 234 | 8/21/2012 | 11/13/2012 | Lift - Tech LTD | c | gfhgj | mnm | Building |
|---|
| 9 | 4 | f | 8 | 417 | 235 | 8/21/2012 | 11/13/2012 | Lift - Tech LTD | d | wrw | eeqw | Billable |
|---|
|
|---|
. After running the macro I wrote, new sheets are added that look like this
| Book1 |
|---|
|
|---|
| A | B | C | D | E | F | G | H | I | J | K | L |
|---|
| 1 | P | C | R | Device # | Location Address | Test Date | AOC Due Date | Third Party Witness | Elevator Part | Violation Condition | Suggested Remedy | Classification (Building, Billable,
Maintenance, Repair) |
|---|
| 2 | 1 | c | 2 | 414 | 232 | 8/21/2012 | 11/13/2012 | Lift - Tech LTD | a | fa | hz | Building |
|---|
| 3 | 3 | e | 6 | 416 | 234 | 8/21/2012 | 11/13/2012 | Lift - Tech LTD | c | gfhgj | mnm | Building |
|---|
|
|---|
| Book1 |
|---|
|
|---|
| A | B | C | D | E | F | G | H | I | J | K | L |
|---|
| 1 | P | C | R | Device # | Location Address | Test Date | AOC Due Date | Third Party Witness | Elevator Part | Violation Condition | Suggested Remedy | Classification (Building, Billable,
Maintenance, Repair) |
|---|
| 2 | 69 | M | 7 | 2P10193 | 231 W. 246th ST, Bronx | 8/21/2012 | 11/13/2012 | Lift - Tech LTD | Code Data Plate | Missing | Provide | Billable |
|---|
| 3 | 4 | f | 8 | 417 | 235 | 8/21/2012 | 11/13/2012 | Lift - Tech LTD | d | wrw | eeqw | Billable |
|---|
|
|---|
| Book1 |
|---|
|
|---|
| A | B | C | D | E | F | G | H | I | J | K | L |
|---|
| 1 | P | C | R | Device # | Location Address | Test Date | AOC Due Date | Third Party Witness | Elevator Part | Violation Condition | Suggested Remedy | Classification (Building, Billable,
Maintenance, Repair) |
|---|
| 2 | 5 | J | 1 | 2P10193 | 231 W. 246th ST, Bronx | 8/21/2012 | 11/13/2012 | Lift - Tech LTD | Car Door/Gate | Misaligned | Adjust | Repair |
|---|
| 3 | 2 | d | 4 | 415 | 233 | 8/21/2012 | 11/13/2012 | Lift - Tech LTD | b | asfgg | aaad | Repair |
|---|
|
|---|
| Book1 |
|---|
|
|---|
| A | B | C | D | E | F | G | H | I | J | K | L |
|---|
| 1 | P | C | R | Device # | Location Address | Test Date | AOC Due Date | Third Party Witness | Elevator Part | Violation Condition | Suggested Remedy | Classification (Building, Billable,
Maintenance, Repair) |
|---|
| 2 | 6 | B | 1 | 2W12080 | 231 W. 246th ST, Bronx | 8/21/2012 | 11/13/2012 | Lift - Tech LTD | Car Door/Gate Contact | Insufficent | Adjust | Maintenance |
|---|
| 3 | 21 | B | 1 | 2W12080 | 231 W. 246th ST, Bronx | 8/21/2012 | 11/13/2012 | Lift - Tech LTD | Interlocks | Insufficent | Adjust | Maintenance |
|---|
|
|---|
…..
I would be adding to this spreadsheet every day so i would need all the rows to be copied over to the same worksheet each time the macro is ran…..
. Each time you run the code all the new sheets are wiped out and the process starts again. So simply update your fill Data sheet and run the program again.
. Here is the code:
<font face=Calibri><SPAN style="color:#00007F">Option</SPAN> <SPAN style="color:#00007F">Explicit</SPAN> <SPAN style="color:#007F00">'Not necerssary but good practice to keep computer memery usage to minimum (and helps show up errors)</SPAN><br><SPAN style="color:#00007F">Sub</SPAN> MicheppsAdvFiltZuNeuTab()<br>Application.ScreenUpdating = <SPAN style="color:#00007F">False</SPAN> <SPAN style="color:#007F00">'Not necerssary but speeds things up a bit, by turning screen upating off.</SPAN><br><SPAN style="color:#00007F">On</SPAN> <SPAN style="color:#00007F">Error</SPAN> <SPAN style="color:#00007F">GoTo</SPAN> TheEnd <SPAN style="color:#007F00">'If anything goes wrong go to the End instead of crashing</SPAN><br><br><SPAN style="color:#00007F">Dim</SPAN> ws <SPAN style="color:#00007F">As</SPAN> Worksheet <SPAN style="color:#007F00">'ws now has Methods and Properties of Worksheets obtained with . dot</SPAN><br><SPAN style="color:#007F00">'Start Bit to Delete Sheets / Tabs------------</SPAN><br>Application.DisplayAlerts = <SPAN style="color:#00007F">False</SPAN> <SPAN style="color:#007F00">'Prevents being asked everytime if you really want to delete the Workbook</SPAN><br><SPAN style="color:#00007F">For</SPAN> <SPAN style="color:#00007F">Each</SPAN> ws <SPAN style="color:#00007F">In</SPAN> ActiveWorkbook.Worksheets<br> <SPAN style="color:#00007F">If</SPAN> ws.Name <> "FullDataSheet" <SPAN style="color:#00007F">Then</SPAN><br> ws.Delete<br> <SPAN style="color:#00007F">Else</SPAN> <SPAN style="color:#007F00">'Presumably then the worksheet name is FullDataSheet s0</SPAN><br> <SPAN style="color:#007F00">' do nothing (Don't delete it!)</SPAN><br> <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br><SPAN style="color:#00007F">Next</SPAN><br>Application.DisplayAlerts = <SPAN style="color:#00007F">True</SPAN> <SPAN style="color:#007F00">'Turn it back on</SPAN><br><SPAN style="color:#007F00">'End Bit to delete new Sheets / Tabs------------</SPAN><br><br><SPAN style="color:#007F00">'Add new Worksheets---</SPAN><br><SPAN style="color:#00007F">Dim</SPAN> Classification <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN> <SPAN style="color:#007F00">'Classification name, not kept constant, used / updated in looping</SPAN><br><SPAN style="color:#00007F">Dim</SPAN> LastClassificationRow <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Byte</SPAN><br><SPAN style="color:#00007F">Let</SPAN> Worksheets.Add(After:=Worksheets(1)).Name = "Unique1" <SPAN style="color:#007F00">'Add a Worksheet after the first, named Unique1 for now</SPAN><br><SPAN style="color:#00007F">Let</SPAN> LastClassificationRow = Sheets("FullDataSheet").Range("L" & Rows.Count).End(xlUp).Row<br>Sheets("FullDataSheet").Range("L1:L" & LastClassificationRow).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sheets("Unique1").Range("A1"), Unique:=<SPAN style="color:#00007F">True</SPAN> <SPAN style="color:#007F00">'Copies entire L Column to first column in sheet2 (Tempory made "Unique1" sheet), The important bit is Unique:=True - that only copies unique bits</SPAN><br><SPAN style="color:#007F00">'---------------------</SPAN><br><br><SPAN style="color:#00007F">Dim</SPAN> LastUnqRow <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Byte</SPAN>, UqeRow <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Byte</SPAN> <SPAN style="color:#007F00">'Rows in tempory Unique sheet</SPAN><br><SPAN style="color:#00007F">Let</SPAN> LastUnqRow = Worksheets("Unique1").Cells.Find(What:="*", After:=Worksheets("Unique1").Cells(1, 1), Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row <SPAN style="color:#007F00">'Get last Unique Row for use in next loop</SPAN><br> <SPAN style="color:#00007F">For</SPAN> UqeRow = 2 <SPAN style="color:#00007F">To</SPAN> LastUnqRow <SPAN style="color:#00007F">Step</SPAN> 1 <SPAN style="color:#007F00">'</SPAN><br> <SPAN style="color:#007F00">'Make new sheet------------</SPAN><br> <SPAN style="color:#00007F">If</SPAN> Sheets("Unique1").Cells(UqeRow, 1).Text <> "" <SPAN style="color:#00007F">Then</SPAN> <SPAN style="color:#007F00">'Assuming a team is there</SPAN><br> <SPAN style="color:#00007F">Let</SPAN> Classification = Sheets("Unique1").Cells(UqeRow, 1).Text <SPAN style="color:#007F00">'Put name in Classification variable</SPAN><br> <SPAN style="color:#00007F">Let</SPAN> Worksheets.Add(After:=Worksheets(1)).Name = Classification <SPAN style="color:#007F00">'Add new worksheet with Classification name</SPAN><br> <br> <br> <SPAN style="color:#00007F">With</SPAN> Sheets("FullDataSheet") <SPAN style="color:#007F00">'Copying data to new sheet----</SPAN><br> .UsedRange.AutoFilter Field:=12, Criteria1:=Classification <SPAN style="color:#007F00">'Filter out everything except with that with the appropriate Classification (makes visible based on the criteria only the stuff you want??)....</SPAN><br> .UsedRange.SpecialCells(xlCellTypeVisible).Copy Destination:=Sheets(Classification).Range("A1") <SPAN style="color:#007F00">', then combine it with SpecialCells to just copy that wot you see, (and then send it to the relavent new sheet , name n).. ( Idid notice that it works the same without the .SpecialCells(xlCellTypeVisible) bit, - but that mayjust be Excel “guessing wot you want” as it does, that is to say it copies by default wot is visible?- not too sure on that one yet.)</SPAN><br> <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN> <SPAN style="color:#007F00">'-------------------------------------------------</SPAN><br> <br> <SPAN style="color:#00007F">With</SPAN> Sheets(Classification).UsedRange <SPAN style="color:#007F00">'Bit of simple Format Tidying up</SPAN><br> .WrapText = <SPAN style="color:#00007F">False</SPAN><br> .Columns.AutoFit<br> <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br> <SPAN style="color:#00007F">Else</SPAN><br> <SPAN style="color:#007F00">'Do nothing if no Classification given</SPAN><br> <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br> <SPAN style="color:#007F00">'-----------------------------</SPAN><br> <SPAN style="color:#00007F">Next</SPAN> UqeRow <SPAN style="color:#007F00">'Go back and make another ner sheet</SPAN><br><br>Sheets("FullDataSheet").AutoFilterMode = <SPAN style="color:#00007F">False</SPAN><br><br>Application.DisplayAlerts = <SPAN style="color:#00007F">False</SPAN> <SPAN style="color:#007F00">'Prevent being asked if you really want to delete Temporary Unique sheet</SPAN><br>Sheets("Unique1").Delete <SPAN style="color:#007F00">' delete the filtered Classification name sheet as you do not need it any more</SPAN><br>Application.DisplayAlerts = <SPAN style="color:#00007F">True</SPAN><br><br>TheEnd:<br>Application.ScreenUpdating = <SPAN style="color:#00007F">True</SPAN> <SPAN style="color:#007F00">'Important to do this here so if anything goes wron then the screen updating is turned back on, ohterwisee the screen is dead</SPAN><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN> <SPAN style="color:#007F00">'MicheppsAdvFiltZuNeuTab()</SPAN></FONT>
. It is in the Sheet Module of Sheet “FullDataSheet” in the following two Files. One File is before and the other after running the macro.
FileSnack | Easy file sharing
FileSnack | Easy file sharing
…….
I am not familiar with macros at all so any help/guidance anyone can provide would be greatly appreciated.
Thanks
Michelle
. If you need any more help in getting started, or have any other questions, then get back.
Alan
P.s. 1. The sizes (Rows / Columns etc.) are all limited to about 255 initially but that can easily be changed.
P.s. 2. Full credit to Alan_P for the code. The important bits I stole from his code in Thread http://www.mrexcel.com/forum/excel-questions/799667-copying-row-based-coloumn-contents-2.html
. You should go through that as the code is discussed and developed in detail.
