VBA to filter top ten values then paste into the related tables

[Bisky]

Hi All,

Extremely new to the forum and VBA. I was wondering if anyone can help me out?

I am looking for a VBA Code that can run through a data dump and filter for the Top ten highest variations and paste the correct data into the related tables.

I also understand this could be done in Pivot Table however I am trying to increase my understanding of VBA.

If anyone could help me with my issue that would be most appreciated

Thanks in Advance !

 

[pbornemeier]

Here is a generic subroutine that must be adapted for your situation:

Option Explicit

Sub FilterForTop10AndCopyResults()
    'Assumes that the data dump is on the Data worksheet
    '  and extracted data should be placed on Sheet2
    
    Dim lLastDataRow As Long
    Dim lLastSheet2ColERow As Long
    
    With Worksheets("Data")
        .AutoFilterMode = False
        lLastDataRow = .Cells(.Rows.Count, 1).End(xlUp).Row  'Last Populated row
    End With
    With Worksheets("Sheet2")
        .AutoFilterMode = False
        lLastSheet2ColERow = .Cells(.Rows.Count, 3).End(xlUp).Row
    End With

    'Criterion for Top 10 is in column H([COLOR="#FF0000"]8[/COLOR]) of the Data worksheet
    'If more complex criteria are required to define "highest variations"
    '  then apply appropriate filters to other columns or add a helper column
    '  that contains results of whatever calculations that are used to
    '  determine the "highest variations" and filter on that.
    Worksheets("Data").Range("$A$1").CurrentRegion.AutoFilter Field:=[COLOR="#FF0000"]8[/COLOR], _
        Criteria1:="10", Operator:=xlTop10Items
        
    'Assumes the data to be copied is in column C and should be copied to the
    '  [COLOR="#0000FF"]cell after last populated row [/COLOR]of column 5 on Sheet2
    Worksheets("Data").Range("C2:C" & lLastDataRow).SpecialCells(xlCellTypeVisible).Copy _
        Destination:=Worksheets("Sheet2").Cells(lLastSheet2ColERow [COLOR="#0000FF"]+ 1[/COLOR], 5)

    'Clear Filter from Data
    Worksheets("Data").AutoFilterMode = False
    
End Sub