Copy entire row to another worksheet if column = specific value

michepps · Sep 4, 2014

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:

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)
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
21	B	1	2W12080	231 W. 246th ST, Bronx	8/21/2012	11/13/2012	Lift - Tech LTD	Interlocks	Insufficent	Adjust	Maintenance
5	J	1	2P10193	231 W. 246th ST, Bronx	8/21/2012	11/13/2012	Lift - Tech LTD	Car Door/Gate	Misaligned	Adjust	Billable
69	M	7	2P10193	231 W. 246th ST, Bronx	8/21/2012	11/13/2012	Lift - Tech LTD	Code Data Plate	Missing	Provide	Billable

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

DocAElstein · Sep 5, 2014

michepps said:
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

FullDataSheet

. 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

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

michepps said:
…..
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:

Option Explicit 'Not necerssary but good practice to keep computer memery usage to minimum (and helps show up errors) Sub MicheppsAdvFiltZuNeuTab() Application.ScreenUpdating = False 'Not necerssary but speeds things up a bit, by turning screen upating off. On Error GoTo TheEnd 'If anything goes wrong go to the End instead of crashing Dim ws As Worksheet 'ws now has Methods and Properties of Worksheets obtained with . dot 'Start Bit to Delete Sheets / Tabs------------ Application.DisplayAlerts = False 'Prevents being asked everytime if you really want to delete the Workbook For Each ws In ActiveWorkbook.Worksheets If ws.Name <> "FullDataSheet" Then ws.Delete Else 'Presumably then the worksheet name is FullDataSheet s0 ' do nothing (Don't delete it!) End If Next Application.DisplayAlerts = True 'Turn it back on 'End Bit to delete new Sheets / Tabs------------ 'Add new Worksheets--- Dim Classification As String 'Classification name, not kept constant, used / updated in looping Dim LastClassificationRow As Byte Let Worksheets.Add(After:=Worksheets(1)).Name = "Unique1" 'Add a Worksheet after the first, named Unique1 for now Let LastClassificationRow = Sheets("FullDataSheet").Range("L" & Rows.Count).End(xlUp).Row Sheets("FullDataSheet").Range("L1:L" & LastClassificationRow).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sheets("Unique1").Range("A1"), Unique:=True 'Copies entire L Column to first column in sheet2 (Tempory made "Unique1" sheet), The important bit is Unique:=True - that only copies unique bits '--------------------- Dim LastUnqRow As Byte, UqeRow As Byte 'Rows in tempory Unique sheet Let LastUnqRow = Worksheets("Unique1").Cells.Find(What:="*", After:=Worksheets("Unique1").Cells(1, 1), Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row 'Get last Unique Row for use in next loop For UqeRow = 2 To LastUnqRow Step 1 ' 'Make new sheet------------ If Sheets("Unique1").Cells(UqeRow, 1).Text <> "" Then 'Assuming a team is there Let Classification = Sheets("Unique1").Cells(UqeRow, 1).Text 'Put name in Classification variable Let Worksheets.Add(After:=Worksheets(1)).Name = Classification 'Add new worksheet with Classification name With Sheets("FullDataSheet") 'Copying data to new sheet---- .UsedRange.AutoFilter Field:=12, Criteria1:=Classification 'Filter out everything except with that with the appropriate Classification (makes visible based on the criteria only the stuff you want??).... .UsedRange.SpecialCells(xlCellTypeVisible).Copy Destination:=Sheets(Classification).Range("A1") ', 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.) End With '------------------------------------------------- With Sheets(Classification).UsedRange 'Bit of simple Format Tidying up .WrapText = False .Columns.AutoFit End With Else 'Do nothing if no Classification given End If '----------------------------- Next UqeRow 'Go back and make another ner sheet Sheets("FullDataSheet").AutoFilterMode = False Application.DisplayAlerts = False 'Prevent being asked if you really want to delete Temporary Unique sheet Sheets("Unique1").Delete ' delete the filtered Classification name sheet as you do not need it any more Application.DisplayAlerts = True TheEnd: Application.ScreenUpdating = True 'Important to do this here so if anything goes wron then the screen updating is turned back on, ohterwisee the screen is dead End Sub 'MicheppsAdvFiltZuNeuTab()

. 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

michepps said:
…….
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.

Copy entire row to another worksheet if column = specific value

michepps

New Member

Excel Facts

DocAElstein

Banned user

Similar threads

Forum statistics

Share this page

Copy entire row to another worksheet if column = specific value

michepps

New Member

Excel Facts

DocAElstein

Banned user

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock