Please help me shorten this.

[O177812]

I have created the following VBA code to copy 3 columns of data onto a different sheet if Column AQ contains a "0"

ActiveWorkbook.Worksheets("IN PROGRESS").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("IN PROGRESS").AutoFilter.Sort.SortFields.Add Key:= _
Range("AQ2:AQ224"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
:=xlSortNormal
With ActiveWorkbook.Worksheets("IN PROGRESS").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
ActiveSheet.Range("$A$2:$AQ$224").AutoFilter Field:=43, Criteria1:="0"
Range("A3").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("COMPLETE").Select
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("IN PROGRESS").Select
ActiveWindow.SmallScroll Down:=-27
Range("B3").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("COMPLETE").Select
Range("B2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("IN PROGRESS").Select
ActiveWindow.SmallScroll Down:=-21
Range("G3").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("COMPLETE").Select
Range("C2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("C:C").EntireColumn.AutoFit

I am hoping someone can help me create a shorter way of doing this.

It would be awesome if the code could just search column AQ for any cells that have a "0" and copy the 3 pieces of data from that row in column A, column B, and Column G, and create a list on the "COMPLETE" sheet.

Thanks for the help!,

 

[Smitty]

It would be awesome if the code could just search column AQ for any cells that have a "0" and copy the 3 pieces of data from that row in column A, column B, and Column G, and create a list on the "COMPLETE" sheet.

Have you tried AutoFilter? Then you can use Goto-->Special-->Visible Cells only and copy/paste. It'll probably be easiest to copy the whole thing to a temp sheet, then delete the columns you don't need, then move what's left to your Complete sheet.

As for cleaning up your code, as a general rule of thumb, whenever you see Select followed by Selection you can eliminate both statements.

E.G.

    Sheets("Sheet1").Select
    Range("A1").Select
    Selection.Copy
    Sheets("Sheet2").Select
    Range("A1").Select
    ActiveSheet.Paste

Can simply be: Sheets("Sheet1").Range("A1").Copy Sheets("Sheet2").Range("A1")

And anything having to do with navigation (ActiveWindow.SmallScroll Down:=-21) can be eliminated altogether.

You also only need Application.CutCopyMode = False once, at the end of your code.

HTH,