0
votes

I need your help.

I would like to Autofilter a column of a table with the following value: begins with AF. And then copy and paste some column to another sheet.

I have written a code but I alwasy get an error when the code reach the following line:

.AutoFilter Field:=rng0.Column, Criteria1:=SearchFor

The error is: Object variable or with block is not set.

I have no idea what is wrong with the code. Please help me.

Sub AF_update()

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False

SearchCol0 = "Prefix+short name"
SearchCol1 = "Site type"
SearchCol2 = "SLA Target"
SearchCol3 = "Mean Rtt (ms)"
SearchCol4 = "Max Rtt (ms)"
SearchCol5 = "Threshold 95%"
SearchCol6 = "Threshold 99%"
SearchFor = "=AF*"

Dim rng0, rng1, rng2, rng3, rng4, rng5, rng6 As Range
Dim lastrow As Long

Set rng0 = ActiveSheet.UsedRange.Find(SearchCol0, , xlValues, xlWhole)
Set rng1 = ActiveSheet.UsedRange.Find(SearchCol1, , xlValues, xlWhole)
Set rng2 = ActiveSheet.UsedRange.Find(SearchCol2, , xlValues, xlWhole)
Set rng3 = ActiveSheet.UsedRange.Find(SearchCol3, , xlValues, xlWhole)
Set rng4 = ActiveSheet.UsedRange.Find(SearchCol4, , xlValues, xlWhole)
Set rng5 = ActiveSheet.UsedRange.Find(SearchCol5, , xlValues, xlWhole)
Set rng6 = ActiveSheet.UsedRange.Find(SearchCol6, , xlValues, xlWhole)



Set Target = ThisWorkbook.Worksheets("AF")
Set Source = ThisWorkbook.Worksheets("RAW DATA")

Target.Select

Range("A2").Select
Range(ActiveCell, Cells(ActiveCell.End(xlDown).Row, ActiveCell.End(xlToRight).Column)).Select
Selection.ClearContents

    Source.Select

    If ActiveSheet.AutoFilterMode = True Then
        Range("a1").AutoFilter
    End If

    Range("A1").Select
    With Selection
    .AutoFilter Field:=rng0.Column, Criteria1:=SearchFor
    End With


    rng0.Offset(1, 0).Select
    Range(Selection, Selection.End(xlDown)).Copy
    Target.Select
    Range("A2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Source.Select
    rng1.Offset(1, 0).Select
    Range(Selection, Selection.End(xlDown)).Copy
    Target.Select
    Range("B2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Source.Select
    rng2.Offset(1, 0).Select
    Range(Selection, Selection.End(xlDown)).Copy
    Target.Select
    Range("C2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Source.Select
    rng3.Offset(1, 0).Select
    Range(Selection, Selection.End(xlDown)).Copy
    Target.Select
    Range("D2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Source.Select
    rng4.Offset(1, 0).Select
    Range(Selection, Selection.End(xlDown)).Copy
    Target.Select
    Range("E2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Source.Select
    rng5.Offset(1, 0).Select
    Range(Selection, Selection.End(xlDown)).Copy
    Target.Select
    Range("F2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Source.Select
    rng6.Offset(1, 0).Select
    Range(Selection, Selection.End(xlDown)).Copy
    Target.Select
    Range("G2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False



    lastrow = Cells(Rows.Count, 5).End(xlUp).Row
    Range("A2:G" & lastrow).Sort key1:=Range("E2:E" & lastrow), order1:=xlDescending, Header:=xlNo

Source.Select
ActiveSheet.AutoFilterMode = False

Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True

MsgBox "Operation Completed!"
End Sub
1
What is the 'ActiveSheet' at the beginning of the procedure? Are the 'SearchCol' lavbels in row 1 of that worksheet?user4039065

1 Answers

0
votes

I've cleaned up your code; primarily removing the reliance on .Select¹ and .Activate¹ but also taking your groups of variables and creating arrays for each group. This allowed loops that greatly shortened the code while allowing for full functionality.

Sub AF_update()
    Dim v As Long, vSearchCols As Variant, vCols As Variant, FilterFor As String
    Dim Source As Worksheet, Target As Worksheet

    'Application.ScreenUpdating = False
    'Application.DisplayAlerts = False
    'Application.EnableEvents = False

    FilterFor = "AF*"

    Set Source = ThisWorkbook.Worksheets("RAW DATA")
    With Source
        'array of 'SearchCol' values on a zero-based index
        vSearchCols = Array("Prefix+short name", "Site type", "SLA Target", "Mean Rtt (ms)", _
                           "Max Rtt (ms)", "Threshold 95%", "Threshold 99%")
        ReDim vCols(0 To UBound(vSearchCols))  'make them the same size
        For v = LBound(vSearchCols) To UBound(vSearchCols)
            vCols(v) = .Rows(1).Cells.Find(What:=vSearchCols(v), LookIn:=xlFormulas, LookAt:=xlWhole).Column
        Next v
    End With

    Set Target = Worksheets("AF")
    With Target
        If .AutoFilterMode Then .AutoFilterMode = False
        With .Cells(1, 1).CurrentRegion
            Debug.Print .Cells(.Rows.Count - 1, .Columns.Count).Address(0, 0, external:=True)
            .Cells.Resize(.Rows.Count - 1, .Columns.Count).Offset(1, 0).ClearContents
        End With
    End With

    With Source
        If .AutoFilterMode Then .AutoFilterMode = False
        With .Cells(1, 1).CurrentRegion
            .AutoFilter Field:=vCols(0), Criteria1:=FilterFor

            'check to see if there is anything to copy across
            With .Cells.Resize(.Rows.Count - 1, .Columns.Count).Offset(1, 0)
                If CBool(Application.Subtotal(103, .Cells)) Then
                    'there is something to transfer; loop through the ranges
                    For v = LBound(vCols) To UBound(vCols)
                        .Columns(vCols(v)).Copy
                        Target.Cells(2, v + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
                                                            SkipBlanks:=False, Transpose:=False
                    Next v
                End If
            End With
        End With
    End With

    With Target
        With .Cells(1, 1).CurrentRegion
            With .Resize(.Rows.Count, 7)
                .Cells.Sort Key1:=.Columns(5), Order1:=xlDescending, _
                            Orientation:=xlTopToBottom, Header:=xlYes
            End With
        End With
    End With

    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.EnableEvents = True

    MsgBox "Operation Completed!"
End Sub

You may wish to step through the code with repeated F8 taps. I've temporarily commented out your Application environment changes.

When dealing with a block or 'island' of data originating from A1, the Range.CurrentRegion property is a fast and effective method of isolating the data when referenced with a With ... End With statement.

I had to guess on which worksheet your macro code started. I chose the RAW DATA worksheet.


¹ See How to avoid using Select in Excel VBA macros for more methods on getting away from relying on select and activate to accomplish your goals.