in need of a macro for a complex task

[Tonyk1051]

Delete row 1 in sheet 1
Highlight column H and insert 2 new columns (do the same for sheet 2)
Highlight column X and insert 1 new column (do the same for sheet 2)

Highlight all of sheet 2 apply data filter

On column G
click select all, check boxes that have Manufacture, Working but missing parts,
tested confirmed defective, tested confirmed damage, picture of defect done

all the data that is found, cut and move to sheet 1

Now on sheet 1

highlight all of it and apply data filter
go to coulmn L and search for TT
all the data that it pulls delete entire row
now search for tv
all the data that it pulls delete entire row
unfilter sheet 1


instructions are always the same but data amount is always
different sometime less some times more, is this something a Macro can do?

 

[Tonyk1051]

i put the .column("W:X") part it shifted the column two times when i just need to shift the coulmn once...

 

[Fluff]

If you just want to insert one column use

    With WS1
        .Rows(1).Delete
        .Columns("H:I").Insert Shift:=xlToRight
        .Columns("W").Insert Shift:=xlToRight
    End With

 

[Tonyk1051]

If you just want to insert one column use

    With WS1
        .Rows(1).Delete
        .Columns("H:I").Insert Shift:=xlToRight
        .Columns("W").Insert Shift:=xlToRight
    End With

Hi, back again, i tried to make a slight adjustment to the code you guys helped me with but it doesnt seem to work, the field number and criteria are def. correct but it just gives me a code when i run it...

With WS2

.Range("A1", .Range("AA" & .Rows.Count).End(xlUp)).AutoFilter Field:=7, Criteria1:=Array( _

"MANUFACTURE", "PICTURE OF DEFECT DONE", "TESTED CONFIRMED DAMAGED", _

"TESTED CONFIRMED DEFECTIVE", "WORKING BUT MISSING PARTS"), Operator:=xlFilterValues

.AutoFilter.Range.Offset(1).Copy WS1.Cells(WS1.Rows.Count, "A").End(xlUp).Offset(1)

.AutoFilter.Range.Offset(1).EntireRow.Delete

.Range("A1").AutoFilter

End With
can you insert a code here where all lines except line 1 in  WS2 is deleted?

With WS1

.Range("A1", .Range("AB" & .Rows.Count).End(xlUp)).AutoFilter Field:=12, Criteria1:="=*TT*", Operator:=xlOr, Criteria2:="=*TV*"

.AutoFilter.Range.Offset(1).EntireRow.Delete

.Range("A1").AutoFilter

End With

With WS1

.Range("A1", .Range("AB" & .Rows.Count).End(xlUp)).AutoFilter Field:=28, Criteria1:="=*Y*"

.AutoFilter.Range.Offset(1).EntireRow.Delete

.Range("A1").AutoFilter

Application.ScreenUpdating = True

End Sub

 

[Fluff]

What do you mean by

the field number and criteria are def. correct but it just gives me a code when i run it...

 

[Tonyk1051]

What do you mean by

the number you put on the original "auto filter 12" 12 is the number of the coulmn the code uses after the coulmn shifts no? so i counted the coulmns and it is the number 28 i put as well as the critieria as its only Y or N. unless my logic is really wrong...

 

[Fluff]

Sorry, but I haven't got a clue what you are talking about.

 

[Tonyk1051]

Sorry, but I haven't got a clue what you are talking about.

its okay -__- anyways below is the original code, can you add in the adjustments of deleting every single line in WS2 after the 5 catergories are moved to WS1? also after deleteing everything in TT and TV can you have look in column AA and to delete anything that has a Y?

Sub tonyk()

Application.ScreenUpdating = False

Dim LastRow As Long, WS1 As Worksheet, WS2 As Worksheet

Set WS1 = Sheets("Not on a Category")

Set WS2 = Sheets("On a Category")

LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

With WS1

.Rows(1).Delete

.Columns("H:I").Insert Shift:=xlToRight

.Columns("X:X").Insert Shift:=xlToRight

.Columns("W").Insert Shift:=xlToRight

End With

With WS2

.Columns("H:I").Insert Shift:=xlToRight

.Columns("X:X").Insert Shift:=xlToRight

.Columns("W").Insert Shift:=xlToRight

End With

With WS2

.Range("A1", .Range("AA" & .Rows.Count).End(xlUp)).AutoFilter Field:=7, Criteria1:=Array( _

"MANUFACTURE", "PICTURE OF DEFECT DONE", "TESTED CONFIRMED DAMAGED", _

"TESTED CONFIRMED DEFECTIVE", "WORKING BUT MISSING PARTS"), Operator:=xlFilterValues

.AutoFilter.Range.Offset(1).Copy WS1.Cells(WS1.Rows.Count, "A").End(xlUp).Offset(1)

.AutoFilter.Range.Offset(1).EntireRow.Delete

.Range("A1").AutoFilter

End With

With WS1

.Range("A1", .Range("AB" & .Rows.Count).End(xlUp)).AutoFilter Field:=12, Criteria1:="=*TT*", Operator:=xlOr, Criteria2:="=*TV*"

.AutoFilter.Range.Offset(1).EntireRow.Delete

.Range("A1").AutoFilter

End With

With WS1

.Range("A1", .Range("AB" & .Rows.Count).End(xlUp)).AutoFilter Field:=28, Criteria1:="=*Y*"

.AutoFilter.Range.Offset(1).EntireRow.Delete

.Range("A1").AutoFilter

Application.ScreenUpdating = True

End Sub

 

[Fluff]

For the first part just add

.UsedRange.Offset(1).Clear

before the End Withline for WS2.
Col AA is 27 not 28

 

[Tonyk1051]

For the first part just add

.UsedRange.Offset(1).Clear

before the End Withline for WS2.
Col AA is 27 not 28

it worked, thank you.

 

[Fluff]

You're welcome.