Copy entire row to another worksheet if column = specific value

michepps

New Member
Joined
Sep 4, 2014
Messages
1
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:
PCRDevice #Location AddressTest DateAOC Due DateThird Party WitnessElevator PartViolation ConditionSuggested RemedyClassification
(Building, Billable, Maintenance, Repair)
6B12W12080231 W. 246th ST, Bronx 8/21/201211/13/2012Lift - Tech LTDCar Door/Gate ContactInsufficentAdjustMaintenance
21B12W12080231 W. 246th ST, Bronx 8/21/201211/13/2012Lift - Tech LTDInterlocksInsufficentAdjustMaintenance
5J12P10193231 W. 246th ST, Bronx 8/21/201211/13/2012Lift - Tech LTDCar Door/GateMisalignedAdjustBillable
69M72P10193231 W. 246th ST, Bronx 8/21/201211/13/2012Lift - Tech LTDCode Data PlateMissingProvideBillable

<TBODY>
</TBODY><COLGROUP><COL><COL span=2><COL><COL><COL><COL><COL><COL><COL><COL><COL></COLGROUP>

I want to copy (not cut) the entire row to a new worksheet when the last column, L, = "Billable". Same for when it = "Maintenance", etc...
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.

I am not familiar with macros at all so any help/guidance anyone can provide would be greatly appreciated.

Thanks
Michelle
 

Excel Facts

How to total the visible cells?
From the first blank cell below a filtered data set, press Alt+=. Instead of SUM, you will get SUBTOTAL(9,)
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
ABCDEFGHIJKL
1PCRDevice #Location AddressTest DateAOC Due DateThird Party WitnessElevator PartViolation ConditionSuggested RemedyClassification (Building, Billable, Maintenance, Repair)
26B12W12080231 W. 246th ST, Bronx8/21/201211/13/2012Lift - Tech LTDCar Door/Gate ContactInsufficentAdjustMaintenance
321B12W12080231 W. 246th ST, Bronx8/21/201211/13/2012Lift - Tech LTDInterlocksInsufficentAdjustMaintenance
45J12P10193231 W. 246th ST, Bronx8/21/201211/13/2012Lift - Tech LTDCar Door/GateMisalignedAdjustRepair
569M72P10193231 W. 246th ST, Bronx8/21/201211/13/2012Lift - Tech LTDCode Data PlateMissingProvideBillable
61c24142328/21/201211/13/2012Lift - Tech LTDafahzBuilding
72d44152338/21/201211/13/2012Lift - Tech LTDbasfggaaadRepair
83e64162348/21/201211/13/2012Lift - Tech LTDcgfhgjmnmBuilding
94f84172358/21/201211/13/2012Lift - Tech LTDdwrweeqwBillable
FullDataSheet


. After running the macro I wrote, new sheets are added that look like this



Book1
ABCDEFGHIJKL
1PCRDevice #Location AddressTest DateAOC Due DateThird Party WitnessElevator PartViolation ConditionSuggested RemedyClassification (Building, Billable, Maintenance, Repair)
21c24142328/21/201211/13/2012Lift - Tech LTDafahzBuilding
33e64162348/21/201211/13/2012Lift - Tech LTDcgfhgjmnmBuilding
Building




Book1
ABCDEFGHIJKL
1PCRDevice #Location AddressTest DateAOC Due DateThird Party WitnessElevator PartViolation ConditionSuggested RemedyClassification (Building, Billable, Maintenance, Repair)
269M72P10193231 W. 246th ST, Bronx8/21/201211/13/2012Lift - Tech LTDCode Data PlateMissingProvideBillable
34f84172358/21/201211/13/2012Lift - Tech LTDdwrweeqwBillable
Billable



Book1
ABCDEFGHIJKL
1PCRDevice #Location AddressTest DateAOC Due DateThird Party WitnessElevator PartViolation ConditionSuggested RemedyClassification (Building, Billable, Maintenance, Repair)
25J12P10193231 W. 246th ST, Bronx8/21/201211/13/2012Lift - Tech LTDCar Door/GateMisalignedAdjustRepair
32d44152338/21/201211/13/2012Lift - Tech LTDbasfggaaadRepair
Repair




Book1
ABCDEFGHIJKL
1PCRDevice #Location AddressTest DateAOC Due DateThird Party WitnessElevator PartViolation ConditionSuggested RemedyClassification (Building, Billable, Maintenance, Repair)
26B12W12080231 W. 246th ST, Bronx8/21/201211/13/2012Lift - Tech LTDCar Door/Gate ContactInsufficentAdjustMaintenance
321B12W12080231 W. 246th ST, Bronx8/21/201211/13/2012Lift - Tech LTDInterlocksInsufficentAdjustMaintenance
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.
 
Upvote 0

Forum statistics

Threads
1,222,039
Messages
6,163,552
Members
451,843
Latest member
vitto

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top