Reputation: 43
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```
Upvotes: 3
Views: 227
Reputation:
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
Upvotes: 2
Reputation: 179
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
Upvotes: 2