Line of code to select only the data on a worksheet to filter and have a formula against

[Mw911]

Hi all,

I've been trying to wrack my brain around trying to sort this code out. At the minute, the macro runs fine but it's based on a set range between B2:B15000 which is a lot! However, I wanted to make sure that the macro would cover everything.

I was wondering if there was a way to make it choose only the data that is there on the worksheet so that whether it be 1000 rows or 10, it would only work as much as needed?

The current code I have is show below..

Sub Filter()
'
' Filter Macro
'
'
    Sheets("Paste Here").Select
    Columns("B:B").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "Count"
    Range("B2").Select
    ActiveCell.FormulaR1C1 = "=COUNTIF(C[-1],RC[-1])"
    Range("B2").Select
    Selection.AutoFill Destination:=Range("B2:B15000")
    Range("B2:B15000").Select
    ActiveWindow.ScrollRow = 1
    Range("A2").Select
    ActiveWorkbook.Worksheets("Paste Here").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Paste Here").Sort.SortFields.Add Key:=Range("A2") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Paste Here").Sort
        .SetRange Range("A2:B15000")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Rows("1:1").Select
    Selection.AutoFilter
    Range("B2").Select
End Sub

Any help would be greatly appreciated!

Thanks all.

MW

 

[ParamRay]

This looks like something spewed up by the macro recorder. I have tidied it up to make it a bit more efficient.

Sub Test()
    
    Dim WS As Worksheet
    Dim LastRow As Long
    
    Set WS = Worksheets("Paste Here")
    
    With WS
        LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row   'Get row of last entry in column A
        .Columns("B:B").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
        .Range("B1").Value = "Count"
        With .Range("B2")
            .Formula = "=COUNTIF(A:A,A2)"
            .AutoFill Destination:=WS.Range("B2:B" & LastRow)
        End With
        With .Range("A1").CurrentRegion 'Sort region and filter
            .Sort Key1:=WS.Range("B1:B" & LastRow), Order1:=xlAscending, Header:=xlYes
            .AutoFilter
        End With
    End With

End Sub

The crucial variable is LastRow, which determines the row of the last entry in column A and, therefore, solves your problem.

 

[Mw911]

Excellent, this works! Thank you gpeacock, appreciate it.