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]

I believe i've figured most of it out now, but could someone please help with referencing another worksheet in the below array criteria? I.e the criteria is in another worksheet but I don't know how to put that in. Please help

Sub data_test_2()
'
' data_test_2 Macro
'

'
    With Worksheets("LNG_PORTFOLIO_2023_SG_HIST").Range("A1")
    
    .AutoFilter Field:=28, Operator:=xlFilterValues, Criteria2:=Array(2, "1/1/2023")

End With
End Sub

 

[vcoolio]

Hello ASD1991,

Which column in your data set holds the start dates?
Which column in your data set holds the end dates?
Is Column A the products column?

Cheerio,
vcoolio

 

[asd1991]

Hello ASD1991,

Which column in your data set holds the start dates?
Which column in your data set holds the end dates?
Is Column A the products column?

Cheerio,
vcoolio

Hi Vcoolio,

I have managed to get the below code to work with the several different filter criteria that I have. I am now trying to copy the filtered cells and paste to the other worksheet. However, when I use the final line in the code it only copies and pastes the headings and none of the data. Would you know why that is?

Code used:

Option Explicit
Sub FilterDates()
Dim date1 As Long, date2 As Long, date3 As Long

date1 = Sheets("LNG_PORT_23_SG").Range("A2").Value2
date2 = Sheets("LNG_PORT_23_SG").Range("B2").Value2
date3 = Sheets("LNG_PORT_23_SG").Range("E2").Value2

With Sheets("LNG_PORTFOLIO_2023_SG_HIST").Range("A1:AC1")
.AutoFilter 28, ">=" & 1 * date1, 7
.AutoFilter 29, "<=" & 1 * date2, 7
.AutoFilter 9, ">=" & 1 * date3, 7
.AutoFilter Field:=1, Criteria1:=Sheets("LNG_PORT_23_SG").Range("C2").Value, Operator:=xlOr, Criteria2:=Sheets("LNG_PORT_23_SG").Range("C3").Value
.SpecialCells(xlCellTypeVisible).Copy Destination:=Sheets("LNG_PORT_23_SG").Range("A11")

End With

End Sub

 

[vcoolio]

Hello ASD1991,

Try adding:-

.Offset(1) in front of .SpecialCells

Cheerio,
vcoolio.

 

[asd1991]

Hello ASD1991,

Try adding:-

.Offset(1) in front of .SpecialCells

Cheerio,
vcoolio.

Hi Vcoolio - when I do that it seems to only copy the first row now with no headings or no other visible data. When I try again it shows an error "no cells were found".

 

[vcoolio]

Hello ASD1991,

To prevent that error message when using the SpecialCells method, you must use the On Error Resume Next error handler:

Option Explicit

Sub FilterDates()
Dim date1 As Long, date2 As Long, date3 As Long

date1 = Sheets("LNG_PORT_23_SG").Range("A2").Value2
date2 = Sheets("LNG_PORT_23_SG").Range("B2").Value2
date3 = Sheets("LNG_PORT_23_SG").Range("E2").Value2

With Sheets("LNG_PORTFOLIO_2023_SG_HIST").Range("A1:AC1")
On Error Resume Next
.AutoFilter 28, ">=" & 1 * date1, 7
.AutoFilter 29, "<=" & 1 * date2, 7
.AutoFilter 9, ">=" & 1 * date3, 7
.AutoFilter Field:=1, Criteria1:=Sheets("LNG_PORT_23_SG").Range("C2").Value, Operator:=xlOr, Criteria2:=Sheets("LNG_PORT_23_SG").Range("C3").Value
.SpecialCells(xlCellTypeVisible).Copy Destination:=Sheets("LNG_PORT_23_SG").Range("A11")

End With

On Error GoTo 0

End Sub

 

[vcoolio]

Further to my last post, it would be best if you uploaded a sample of your workbook so we can try and sort out the other problem for you.
Upload an exact replica of your file to a free file sharing site such as WeTransfer or Drop Box then post the link to your file back here.
Make sure that the sample shows your inputs and the expected outputs. If your data is sensitive then please use dummy data.
Please include the code that you already have.

Cheerio,
vcoolio.

 

[asd1991]

Further to my last post, it would be best if you uploaded a sample of your workbook so we can try and sort out the other problem for you.
Upload an exact replica of your file to a free file sharing site such as WeTransfer or Drop Box then post the link to your file back here.
Make sure that the sample shows your inputs and the expected outputs. If your data is sensitive then please use dummy data.
Please include the code that you already have.

Cheerio,
vcoolio.

Hi Vcoolio - here is the link to the file. MAIN_HA_FILE_TTF_test.xlsm

 

[vcoolio]

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