Selecting,coping and pasting records from filter. 1

[jadams0173]

Using Excel 2000.

I've been trying for the past few hours to use VBA to turn on an autofilter, copy the records it returns to a new sheet at the next unused row. Then clear the contents(not delete) the records from the original sheet. I've been searching a lot through this fora and found some help after I recorded my inital macro.

Also is there a way to not copy the column labels when coping the auto filter contents.

Sub Macro5()

Dim uCol [COLOR=blue]As[/color] [COLOR=blue]Long[/color]
Dim uRow [COLOR=blue]As[/color] [COLOR=blue]Long[/color]
Dim myRange [COLOR=blue]As[/color] [COLOR=blue]Range[/color]

    Sheets("WIP").Select
    Cells(1, 1).Select
    Application.CutCopyMode = [COLOR=blue]False[/color]
    Selection.AutoFilter
    Selection.AutoFilter Field:=4, Criteria1:="Complete"
    uCol = ActiveSheet.UsedRange.Columns.Count
 [COLOR=red]'   uRow = ActiveSheet.UsedRange.Rows.Count
[/color]    uRow = Application.WorksheetFunction.Subtotal(3, [COLOR=#FF00FF]Range[/color]("a1", "a50"))
    
    [COLOR=red]'Range(Cells(10, 1), Cells(uRow, uCol)).Select
[/color]    
[COLOR=red]'    Selection.Copy
[/color]    [COLOR=blue]Set[/color] myRange = Selection.CurrentRegion.SpecialCells(xlCellTypeVisible)
    myRange.Copy
    
    Sheets("Complete").Select
    
    
    uRow = ActiveSheet.UsedRange.Rows.Count
    
    [COLOR=red]'should be last used cell + 1 so A and some variable
[/color]    [COLOR=#FF00FF]Range[/color]("A" & uRow).Select
    ActiveSheet.Paste
[COLOR=red]'    Range("G5").Select
[/color]    Application.CutCopyMode = [COLOR=blue]False[/color]
    ActiveSheet.PivotTables("PivotTable3").RefreshTable
    Sheets("WIP").Select
        Selection.ClearContents
        Selection.Interior.ColorIndex = 2
    Selection.AutoFilter Field:=4
    Selection.AutoFilter
    
    [COLOR=#FF00FF]Range[/color]("A1").Select
[COLOR=blue]End[/color] Sub

 

[SkipVought]

hi,

"Then clear the contents(not delete) the records from the original sheet."

Actually, to maintain the integrity of the TABLE, you must delete the rows from the table. Otherwise, you destroy the table, having empty row between chunks of data.

"Also is there a way to not copy the column labels when coping the auto filter contents."

with Sheets("WIP").[A1].currentregion
  Sheets("WIP").range(cells(2,1), cells(.rows.count, .columns.count)).copy
end with

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[SkipVought]

Sub MacroNew()

    Dim uCol As Long
    Dim uRow As Long
    Dim lRow As Long
    Dim myRange As Range

    With Sheets("WIP")
        With .Cells(1, 1)
            .AutoFilter
            .AutoFilter Field:=4, Criteria1:="Complete"
        End With
        With .[A1].CurrentRegion
            uCol = .Columns.Count
            uRow = .Rows.Count
        End With
       .Range(Cells(2, 1), Cells(uRow, uCol)).Copy
    End With
    
    With Sheets("Complete")
        lRow = .[A1].CurrentRegion.Rows.Count + 1
        .Cells(lRow, 1).PasteSpecial xlPasteValues
    End With
    
End Sub

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[jadams0173]

Hi SkipVought,

Thanks for the responses. I will give them a try shortly and let you know how it all comes out!!

 

[jadams0173]

Skip,

Thanks so much for the help. I made a few small changes and added some code but that what you provided was great! Enjoy the

I also took your advice and delete the lines instead of clearing the contents.

 

[SkipVought]

You'll also notice that it these thing can be done without using the Select or Activate methods, which is a far better coding technique and results in better performance.

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[jadams0173]

Yes SkipVought I was noticing that you didn't use those methods. I didn't encounter an error if the I started the code running and I was on the Complete sheet and not the WIP sheet. Error is Runtime error 1004 Application defined or object defined error and it occurs on this line of code.

.Range(Cells(2, 2), Cells(uRow, uCol)).Copy

I fixed it by adding the Select in blue

Sub MacroNew()

    Dim uCol As Long
    Dim uRow As Long
    Dim lRow As Long
    Dim myRange As Range

    With Sheets("WIP")
        [blue].Select[/blue]
        With .Cells(1, 1)
            .AutoFilter
            .AutoFilter Field:=4, Criteria1:="Complete"
        End With
        With .[A1].CurrentRegion
            uCol = .Columns.Count
            uRow = .Rows.Count
        End With
        'this will start with cell B2 and copy all of the filtered data.
       .Range(Cells(2, 2), Cells(uRow, uCol)).Copy
    End With

There are 2 other things I'm trying to work through. One is the delete which I'm doing this way.

    With Sheets("WIP")
        'Delete the cells from the autofilter
        .Range(Cells(2, 2), Cells(uRow, uCol)).Delete
        'turn the autfilter off
        Selection.AutoFilter
    End With

And the last is if there are no cells that match the criteria of the autofilter, it copies the entire sheet (there's only ~15-20 rows in the entire sheet) to the complete worksheet.

Thanks again for you help in getting me well on my way to a good solution.

 

[SkipVought]

notice the DOTs added...

Sub MacroNew()

    Dim uCol As Long
    Dim uRow As Long
    Dim lRow As Long
    Dim myRange As Range

    With Sheets("WIP")
        With .Cells(1, 1)
            .AutoFilter
            .AutoFilter Field:=4, Criteria1:="Complete"
        End With
        With .[A1].CurrentRegion
            uCol = .Columns.Count
            uRow = .Rows.Count
        End With
'DOTS added in this statement to reference the sheet.
       .Range(.Cells(2, 1), .Cells(uRow, uCol)).Copy
    End With
    
    With Sheets("Complete")
        lRow = .[A1].CurrentRegion.Rows.Count + 1
        .Cells(lRow, 1).PasteSpecial xlPasteValues
    End With
    
End Sub

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[SkipVought]

on your other questions...

    With Sheets("WIP")
        'Delete the cells from the autofilter
        .Range(Cells(2, 2), Cells(uRow, uCol)).Delete
        'turn the autfilter off
        Selection.AutoFilter
    End With

there is no selection. Rather...

    With Sheets("WIP")
        'Delete the cells from the autofilter
        .Range(Cells(2, 2), Cells(uRow, uCol)).Delete xlshiftup
        'turn the autfilter off
        .[A1].AutoFilter
    End With

No visible cells in filter...

with Sheets("WIP").Range(Cells(1, 1), Cells(uRow, uCol)).specialcells(xlcelltypevisible)
  if .rows.count = 1 then
    'houston, we have no visible data
  else
    'copy the visible data
  end if
end with

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[jadams0173]

Thanks again skip!

 

[jadams0173]

Since I can't give you another star

 

[SkipVought]

You're welcome!

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}