Autofilter with date criteria returns blank

user_11374493 0
Viewed 117

I have the below code to filter data on one sheet with criteria in another sheet. The code seems to work but always just returns blank, not sure why.

Could someone please help?

Sub data_test_2()
'
' data_test_2 Macro
'


Dim r As Range, filt As Range, d1 As Long, d2 As Long
With Worksheets("LNG_PORT_23_SG")
d1 = .Range("A2").Value
d2 = .Range("B2").Value
With Worksheets("LNG_PORTFOLIO_2023_SG_HIST")
.Range("A1").CurrentRegion.AutoFilter field:=9, Criteria1:=">=" & CDate(d1)

End With
End With
End Sub

UPDATE: Code i'm using now works perfect for the filtering bit, just can't seem to copy all of the filtered data and pasted onto the LNG_PORT_23_SG. I'd want to clear any existing data from cell A11 on this sheet and then have the new filtered data copy and pasted.

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```
autofill vba excel date variables
2 Answers

Just a couple of observations about your code.

If you intend using variables, always put Option Explicit at the top of your procedure – it forces declaration.

Don’t use variable names like d1 or d2 because it’s too easy to cause confusion with actual cell addresses. Also, don’t declare variables you never use.

The following code has been tested and works based on your 2 date columns on the LNG_PORTFOLIO_2023_SG_HIST sheet being I and AC, and your source for the dates being cells A2 and B2 on the LNG_PORT_23_SG sheet. Those cells should be formatted date.

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

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

With Sheets("LNG_PORTFOLIO_2023_SG_HIST").Range("A1:AC1")
    .AutoFilter 9, ">=" & 1 * date1, 7
    .AutoFilter 29, "<=" & 1 * date2, 7
End With

End Sub

EDIT

Based on your latest comment regarding the additional criteria - and the desire to copy the filtered data to the LNG_PORT_23_SG sheet, please see the amended code below.

TAKE NOTE of the option of choosing whether to copy with or without the headings - simply uncomment / delete as appropriate. Also, please do not use On Error Resume Next - it can hide all sorts of problems...

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

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
x = Sheets("LNG_PORT_23_SG").Range("C2").Value2
y = Sheets("LNG_PORT_23_SG").Range("C3").Value2

Application.Goto Sheets("LNG_PORTFOLIO_2023_SG_HIST").Range("A1")
With Sheets("LNG_PORTFOLIO_2023_SG_HIST").Range("A1").CurrentRegion
    .AutoFilter 1, x, 2, y, 7
    .AutoFilter 28, ">=" & 1 * date1, 7
    .AutoFilter 29, "<=" & 1 * date2, 7
    .AutoFilter 9, ">=" & 1 * date3, 7
    .Copy Sheets("LNG_PORT_23_SG").Range("A11")             '<~~ use this line to copy including headings
    '.Offset(1).Copy Sheets("LNG_PORT_23_SG").Range("A11")  '<~~ OR this line to exclude headings
    .AutoFilter
End With

Application.Goto Sheets("LNG_PORT_23_SG").Range("A1")

End Sub
Admin1

To answer your comment from kevin9999's respond about needing to copy the filtered result to another sheet, you can do that by changing the following statement from

With Sheets("LNG_PORTFOLIO_2023_SG_HIST").Range("A1:AC1")

to

With Sheets("LNG_PORTFOLIO_2023_SG_HIST").Range("A1").CurrentRegion

By using .CurrentRegion, it automatically selects a continuous range of cells that is associated with A1. You would need to ensure that there are no breaks in the columns headers or empty rows though. Note that changing A1 to A11 won't change the result as it looks for any continuous cells above, to the left, to the right, and below.

If you do have breaks in the range/table, then another option would be to use a variable to specify the last row and last column of your data. Or as asked in the comment, you need to only start from cell A1 you can use this other method. There are multiple ways to do this, but my preferred method is to use the Cells.Find() method:

RowNum = Sheets("LNG_PORTFOLIO_2023_SG_HIST").Cells.Find("*", SearchOrder:=xlByRows, searchdirection:=xlPrevious).Row
ColNum = Sheets("LNG_PORTFOLIO_2023_SG_HIST").Cells.Find("*", SearchOrder:=xlByRows, searchdirection:=xlPrevious).Column

You can then change the earlier statement to

With Sheets("LNG_PORTFOLIO_2023_SG_HIST").Range(Cells(1, 11), Cells(RowNum, ColNum))

Cells(1, 11) is the same as A1 while Cells(RowNum, ColNum) would be the last column letter and last row from sheet LNG_PORTFOLIO_2023_SG_HIST.

FYI, your updated code didn't paste correctly so it needs to be reformatted. But something like this should work.

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

'Set header names
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").CurrentRegion
    On Error Resume Next

    'Filter Data
    .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
    
    'Identify last row and column of range
    RowNum = .Cells.Find("*", SearchOrder:=xlByRows, searchdirection:=xlPrevious).Row
    ColNum = .Cells.Find("*", SearchOrder:=xlByRows, searchdirection:=xlPrevious).Column
    
    'Copy to another sheet
    .Range(Cells(1, 1), Cells(RowNum, ColNum)).SpecialCells(xlCellTypeVisible).Copy Destination:=Sheets("LNG_PORT_23_SG").Range("A11")
End With

On Error GoTo 0

End Sub
user_113844910
Related