Copy rows onto another worksheet based on multiple criteria (dynamic criteria)

[asd1991]

I'm trying to copy rows from one sheet to another worksheet based on a number of criteria (currently from a dropdown). I am currently able to do this for non-dynamic (non-changing) criteria using either an excel formula or VBA coda (which is much faster).

However, how can I set up my macro so that it captures the criteria selected in the drop down, rather than a pre-selected criteria in the code.

The drop down criteria is the following, where I would select start date, end date, product, and buy/sell. Preferably, I'd like the macro based on this dynamic selection which once run will produce the required data below.

Criteria (which will change as selected from dropdown)

1. Excel Formula:

=IFERROR(INDEX(LNG_PORTFOLIO_2023_SG_HIST!$B$2:$AD$1000,SMALL(IF(COUNTIF(LNG_PORT_23_SG!$C$2,LNG_PORTFOLIO_2023_SG_HIST!$B$2:$B$1000)*COUNTIF(LNG_PORT_23_SG!$D$2,LNG_PORTFOLIO_2023_SG_HIST!$W$2:$W$1000)*COUNTIF(LNG_PORT_23_SG!$A$2,LNG_PORTFOLIO_2023_SG_HIST!$AC$2:$AC$1000)*COUNTIF(LNG_PORT_23_SG!$B$2,LNG_PORTFOLIO_2023_SG_HIST!$AD$2:$AD$1000),MATCH(ROW(LNG_PORTFOLIO_2023_SG_HIST!$C$2:$C$1000),ROW(LNG_PORTFOLIO_2023_SG_HIST!$C$2:$C$1000)),""),ROWS(LNG_PORTFOLIO_2023_SG_HIST!$A$1:B1)),COLUMNS(LNG_PORTFOLIO_2023_SG_HIST!$A$1:B1)),"")

2. VBA code

Sub tgr()

    Dim wsData As Worksheet
    Dim wsDest As Worksheet
    Dim aCriteria() As String

    Set wsData = Sheets("LNG_PORTFOLIO_2023_SG_HIST")    'Copying FROM this worksheet (it contains your data)
    Set wsDest = Sheets("LNG_PORT_23_SG")        'Copying TO this worksheet (it is your destination)

    'Populate your array of values to filter for
    ReDim aFruit(2 To 4)
    aCriteria1(2) = "TTF M-1 Swap"
    aCriteria2(4) = "Validated"
    

    With wsData.Range("B2", wsData.Cells(wsData.Rows.Count, "B").End(xlUp))
        .AutoFilter 1, aCriteria, xlFilterValues   'Filter using the array, this avoids having to do a loop

        'Copy the filtered data (except the header row) and paste it as values
        .Offset(1).EntireRow.Copy
        wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Offset(1).PasteSpecial xlPasteValues
        Application.CutCopyMode = False     'Remove the CutCopy border
        .AutoFilter     'Remove the filter
    End With

End Sub

 

[asd1991]

Hello ASD1991,

Try it as follows:-

Sub Test()

        Dim Dt1 As Long: Dt1 = Sheet9.Range("A2").Value
        Dim Dt2 As Long: Dt2 = Sheet9.Range("B2").Value
        Dim Dt3 As Long: Dt3 = Sheet9.Range("E2").Value
        Dim P1 As String: P1 = Sheet9.Range("C2").Value
        Dim P2 As String: P2 = Sheet9.Range("C3").Value
       
Application.ScreenUpdating = False

Sheet9.[A11].CurrentRegion.Offset(1).ClearContents

        With Sheet8.Range("A1:AC1")
                .AutoFilter 28, ">=" & 1 * Dt1
                .AutoFilter 29, "<=" & 1 * Dt2
                .AutoFilter 9, ">=" & 1 * Dt3
        With .Offset(1)
                .AutoFilter 1, P1, xlOr, P2
                .Copy Sheet9.[A12]
        End With
                .AutoFilter
        End With
       
Application.ScreenUpdating = True

End Sub

Cheerio,
vcoolio

Hi Vcoolio - Thanks for that. When I try run I get the error "variable not found" with the sub test() highlighted in yellow? Probably just me not entering it in properly? Sorry i'm a complete novice!

 

[vcoolio]

Hello ASD1991,

It works fine on my end.
Did you type the code into the module or did you copy/paste it?

You may actually be better off to use the Advanced Filter if you're interested.

Cheerio,
vcoolio.