Solved: filter by month

[CatDaddy]

i feel like my logic is right, but i continue to get error on the last line (the filter criteria and whatnot)

Dim Rng As Range
Dim MonStart As Long, MonEnd As Long
Dim MonCurrent As String, MonDefault As String, MSS As String, MES As String

MonDefault = DatePart("m", Now)

'INPUTBOX FOR CURRENT MONTH
Worksheets("Tracking Sheet").Activate
MonCurrent = InputBox("Reporting Month?", , MonDefault)

MSS = MonCurrent & "/1/2011"
MES = MonCurrent & "/31/2011"

MonStart = CLng(DateValue(MSS))
MonEnd = CLng(DateValue(MES))

Selection.AutoFilter

ActiveWorkbook.Sheets(1).Activate

Set Rng = Range("A1:BZ" & ActiveSheet.Rows.Count)
ActiveSheet.Range(Rng).AutoFilter Field:=37, Criteria1:=">=" & MonStart, _
Operator:=xlAnd, Criteria2:="<=" & MonEnd

[CharlesH]

Hi,

Just a quickie.Your showing "AutoFilter Selection" but your not specifying the selection range.

[CharlesH]

CatDaddy,


The following code may help. You still need to set the Filter range.




Sub aa()
Dim Rng As Range
Dim MonStart As Long, MonEnd As Long
Dim dYr As Double, iMth As Integer
Dim sMth As String
Dim LastDay, LastDayDate, FirstDay, FirstDayDate

Dim MonCurrent As Integer, MonDefault As String, MSS As Variant, MES As Variant

MonDefault = DatePart("m", Now)

'INPUTBOX FOR CURRENT MONTH
Worksheets("Sheet1").Activate
MonCurrent = InputBox("Reporting Month?", , MonDefault)

dYr = Year(Now)
iMth = MonCurrent + 1 'Month(MonCurrent) + 1
sMth = Format(Now, "mmmm")
'Get last day info
LastDayDate = Format(DateSerial(dYr, iMth, 0), " mm/dd/yy")
'get 1st day info
FirstDayDate = Format(DateSerial(dYr, iMth - 1, 1), " mm/dd/yy")
MSS = FirstDayDate
MES = LastDayDate

MonStart = CLng(DateValue(MSS))
MonEnd = CLng(DateValue(MES))

'Set your filter range here''
''Activesheet.Range("A3:G3").Select
Selection.AutoFilter

ActiveWorkbook.Sheets(1).Activate

Set Rng = Range("A1:BZ" & ActiveSheet.Rows.Count)
ActiveSheet.Range(Rng).AutoFilter Field:=37, Criteria1:=">=" & MonStart, _
Operator:=xlAnd, Criteria2:="<=" & MonEnd
End Sub

[CatDaddy]

Dim Rng As Range
Dim MonStart As Long, MonEnd As Long
Dim dYr As Double, iMth As Integer
Dim sMth As String
Dim LastDay, LastDayDate, FirstDay, FirstDayDate
Dim MonCurrent As Integer, MonDefault As String, MSS As Variant, MES As Variant

MonDefault = DatePart("m", Now)

'INPUTBOX FOR CURRENT MONTH
Worksheets(1).Activate
MonCurrent = InputBox("Reporting Month?", , MonDefault)
dYr = Year(Now)
iMth = MonCurrent + 1 'Month(MonCurrent) + 1
sMth = Format(Now, "mmmm")
'Get last day info
LastDayDate = Format(DateSerial(dYr, iMth, 0), " mm/dd/yy")
'get 1st day info
FirstDayDate = Format(DateSerial(dYr, iMth - 1, 1), " mm/dd/yy")
MSS = FirstDayDate
MES = LastDayDate

MonStart = CLng(DateValue(MSS))
MonEnd = CLng(DateValue(MES))

ActiveWorkbook.Sheets(1).Activate
ActiveSheet.Range("A1").Select
Selection.AutoFilter


Set Rng = Range("A1:BZ" & ActiveSheet.Rows.Count)
ActiveSheet.Range(Rng).AutoFilter Field:=37, Criteria1:=">=" & MonStart, _
Operator:=xlAnd, Criteria2:="<=" & MonEnd

same error :/

i really appreciate the help also! :)

[CharlesH]

Hum,


It should work. When I do a debug I can see the start date and end date.
Wold it be possible for you attach a copy of the workbook?

[CatDaddy]

Hum,


It should work. When I do a debug I can see the start date and end date.
Wold it be possible for you attach a copy of the workbook?

too much confidential info...but i agree i debugged it to show me the start and end dates as well and they are correct (they were also correct with my old code), theres nothing special about the workbook you know?

i can whip up a dummy tomorrow morning if you think it would help

[CharlesH]

HI,

I'm showing you a code that I used that is similar to yours. It may help you.
Yes the code is long, but..
Also what is the error you are receiving?


Sub FilterByExactDate()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim Mygoto As Boolean
Dim i As Long
Dim Dlrow As Long
Dim Mytckr As String
Dim Mydate As String
Dim satLrow As Long
Dim Elrow As Long
Dim satws As Worksheet
Dim dDate As Date
Dim dDate2 As Date
Dim strDate As String
Dim lDate As Long
Dim ldate2 As Long
Dim rng As Range
Set satws = Sheets("Scan all trades")
''' get last row of sat ''
satLrow = satws.Range("A65536").End(xlUp).Row
For i = 2 To satLrow
Mygoto = False
Application.Calculation = xlCalculationManual
Mytckr = satws.Cells(i, 2).Text
Mydate = satws.Cells(i, 15).Text
If Mydate = satws.Cells(i - 1, 15).Text And Mytckr = satws.Cells(i - 1, 2).Text Then
Mygoto = True
GoTo Nxt2 '' go to next row if dates match
End If
Sheets("Datasheet").Range("A5").Value = Mytckr
Sheets("Datasheet").Range("B5").Value = Mydate
Sheets("Exported").Activate
dDate = Sheets("Datasheet").Range("B2")
dDate2 = Sheets("Datasheet").Range("B3")
dDate = DateSerial(Year(dDate), Month(dDate), Day(dDate))
dDate2 = DateSerial(Year(dDate2), Month(dDate2), Day(dDate2))
lDate = dDate
ldate2 = dDate2
Elrow = Sheets("Exported").Range("A65536").End(xlUp).Row + 1
Sheets("Exported").Range("A1").AutoFilter
Sheets("Exported").Range("A1").AutoFilter Field:=1, Criteria1:=Sheets("Datasheet").Range("A5")
Sheets("Exported").Range("A1").AutoFilter Field:=2, Criteria1:=">=" & lDate, Operator:=xlAnd, Criteria2:="<=" & ldate2
Sheets("Exported").Range("B2:B" & Elrow).Sort Key1:=Range("B2"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
'''''''''''
Set rng = ActiveSheet.AutoFilter.Range
rng.Offset(1, 1).Resize(rng.Rows.Count - 1, 2).Copy
Sheets("Datasheet").Range("C6").PasteSpecial xlValue
Application.CutCopyMode = xlCopy
''''''''''''''
'''''''''''''''''''''I just copied all the formulas you had written, and changed names on those that I thought could use a new name, dDate became xDate....
'''''''''''''''''''''it seems like it works, even though I don't quite understand whats behind the formulas :-)
Dim xDate As Date
Dim xDate2 As Date
Dim stxDate As String
Dim ydate As Long
Dim ydate2 As Long
xDate = Sheets("Datasheet").Range("Q2")
xDate2 = Sheets("Datasheet").Range("Q3")
Sheets("Exported").Activate
xDate = DateSerial(Year(xDate), Month(xDate), Day(xDate))
xDate2 = DateSerial(Year(xDate2), Month(xDate2), Day(xDate2))
ydate = xDate
ydate2 = xDate2

Sheets("Exported").Range("A1").AutoFilter
Sheets("Exported").Range("A1").AutoFilter Field:=1, Criteria1:=Sheets("Datasheet").Range("A5")
Sheets("Exported").Range("A1").AutoFilter Field:=2, Criteria1:=">=" & ydate, Operator:=xlAnd, Criteria2:="<=" & ydate2
Elrow = Sheets("Exported").Range("A65536").End(xlUp).Row + 1
ActiveWorkbook.Worksheets("Exported").Sort.SortFields.Add Key:=Range( _
"B2:B" & Elrow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Exported").Sort
.SetRange Range("A1:G" & Elrow)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'''''''''''
Set rng = ActiveSheet.AutoFilter.Range
rng.Offset(1, 1).Resize(rng.Rows.Count - 1, 2).Copy
Sheets("Datasheet").Range("R6").PasteSpecial xlValue
Application.CutCopyMode = xlCopy
''''''''''''''
'Sheets("Datasheet").Activate
Application.Calculation = xlCalculationAutomatic
satws.Range("P" & i).Value = Sheets("Datasheet").Range("N2").Text
satws.Range("Q" & i).Value = Sheets("Datasheet").Range("N3").Text
satws.Range("R" & i).Value = Sheets("Datasheet").Range("N4").Text
satws.Range("S" & i).Value = Sheets("Datasheet").Range("N5").Text
satws.Range("T" & i).Value = Sheets("Datasheet").Range("N6").Text
satws.Range("U" & i).Value = Sheets("Datasheet").Range("N7").Text
satws.Range("V" & i).Value = Sheets("Datasheet").Range("N8").Text
satws.Range("W" & i).Value = Sheets("Datasheet").Range("N9").Text
satws.Range("X" & i).Value = Sheets("Datasheet").Range("N10").Text
satws.Range("Y" & i).Value = Sheets("Datasheet").Range("N11").Text
satws.Range("Z" & i).Value = Sheets("Datasheet").Range("N12").Text
satws.Range("AA" & i).Value = Sheets("Datasheet").Range("N13").Text
satws.Range("AB" & i).Value = Sheets("Datasheet").Range("N14").Text
satws.Range("AC" & i).Value = Sheets("Datasheet").Range("N15").Text
satws.Range("AD" & i).Value = Sheets("Datasheet").Range("N16").Text
satws.Range("AE" & i).Value = Sheets("Datasheet").Range("N17").Text
satws.Range("AF" & i).Value = Sheets("Datasheet").Range("N18").Text
satws.Range("AG" & i).Value = Sheets("Datasheet").Range("N19").Text
satws.Range("AH" & i).Value = Sheets("Datasheet").Range("N20").Text
satws.Range("AI" & i).Value = Sheets("Datasheet").Range("N21").Text
satws.Range("AJ" & i).Value = Sheets("Datasheet").Range("O2").Text
satws.Range("AK" & i).Value = Sheets("Datasheet").Range("O3").Text
satws.Range("AL" & i).Value = Sheets("Datasheet").Range("O6").Text
satws.Range("AM" & i).Value = Sheets("Datasheet").Range("O7").Text
satws.Range("AN" & i).Value = Sheets("Datasheet").Range("O8").Text
satws.Range("AO" & i).Value = Sheets("Datasheet").Range("O10").Text
satws.Range("AP" & i).Value = Sheets("Datasheet").Range("O11").Text
satws.Range("AQ" & i).Value = Sheets("Datasheet").Range("O14").Text
satws.Range("AR" & i).Value = Sheets("Datasheet").Range("O15").Text
satws.Range("AS" & i).Value = Sheets("Datasheet").Range("O16").Text
Nxt2:
''''''''''''''' clear C and D also R and S in Datasheet '''
If Mygoto = False Then
Dlrow = Sheets("Datasheet").Range("C65536").End(xlUp).Row
With Sheets("Datasheet")
.Range("C6:D" & Dlrow).ClearContents
.Range("R:S").ClearContents
End With
End If
Next i
End Sub

[CharlesH]

Hi, See if changing this line. Tried to use code tags but for some reason it didn't work. Change the rng to A1.

[CharlesH]

HI change this line



From

ActiveSheet.Range(Rng).AutoFilter Field:=37, Criteria1:=">=" & MonStart, _
Operator:=xlAnd, Criteria2:="<=" & MonEnd

To

ActiveSheet.Range("A1").AutoFilter Field:=37, Criteria1:=">=" & MonStart, _
Operator:=xlAnd, Criteria2:="<=" & MonEnd

[CatDaddy]

HI change this line



From


ActiveSheet.Range(Rng).AutoFilter Field:=37, Criteria1:=">=" & MonStart, _
Operator:=xlAnd, Criteria2:="<=" & MonEnd


To


ActiveSheet.Range("A1").AutoFilter Field:=37, Criteria1:=">=" & MonStart, _
Operator:=xlAnd, Criteria2:="<=" & MonEnd


We're not worthy!!!!!!!! We're scum! :beerchug:

[CharlesH]

Thanks for the "Beer"

[Aussiebear]

Tried to use code tags but for some reason it didn't work.
Unlike other forums which allow the use of tags, we prefer contributors to use instead, the green VBA button found on the right of the buttons above the reply box, sets out the contributed code in a format which is easier to read and is used here, courtesy of www.thecodenet.com (http://www.thecodenet.com/)

[CharlesH]

Aussiebear,

Thanks. I'll use the tags as you suggested.