Something wrong with multiple criteria filter macro

[Gliori]

Hello! I'm having trouble with this filter macro below. What I want to do is to filter everything except "jan" so I've written all the other months in the criteria. But for some reason it filters everything and the sheet becomes blank. Can anyone help me with this one?

Selection.AutoFilter
ActiveSheet.Range("$A$1:$R$500").AutoFilter Field:=12, Criteria1:=Array(feb, mar, apr, maj, jun, jul, aug, sep, okt, nov, dec, "="), Operator:=xlFilterValues

 

[MARK858]

Happy you got it working but if you are doing

x = DateSerial(Year(Date), RESP1 [COLOR="#FF0000"]+ 0[/COLOR], 1)

then you can remove it totally i.e.

x = DateSerial(Year(Date), RESP1, 1)

the reason the +1 was in their was you stated...

I want my macro the filter all months after the one you choose in the input box

 

[Gliori]

Aha, my bad then, well now it's perfect after all

 

[Gliori]

Hello again,
I've noticed a problem that I can't fix myself... So I need to ask for your help here again.

The three top rows on the worksheet are titles, and I want to leave this "unfiltered". At the bottom row I have a few sum formulas, which I too want to leave without filtering. The top row stays untouched but the rest seem to be filtered with the code.

Is there anyway to post the excel document here so you can understand what I mean and try codes on it?

Thanks in advance for your help!

 

[MARK858]

Select the sheet with the dates on and run the code below.
Is the range copied to the "MyTest" sheet correct?

Sub FiltTest()
    Dim x As Long, y As Long, RESP1 As String, RESP2 As String, Shtx As Worksheet

    RESP1 = InputBox("Choose the number which represents the month you want to filter from.")
    RESP2 = InputBox("Choose the number which represents the month you want to filter to.")

    x = DateSerial(Year(Date), RESP1, 1)
    y = DateSerial(Year(Date), RESP2 + 1, 0)

    Set Shtx = ActiveSheet
    Worksheets.Add(After:=Worksheets(Worksheets.count)).Name = "MyTest"

    With Shtx.Range("A1:R" & Shtx.Range("A" & Rows.count).End(xlUp).Row)
        .AutoFilter Field:=12, Criteria1:= _
                    ">=" & x, Operator:=xlAnd, Criteria2:="<=" & y
        On Error Resume Next
        .Offset(3).Resize(.Rows.count - 4).SpecialCells(xlCellTypeVisible).Copy _
                Sheets("MyTest").Range("A" & Rows.count).End(xlUp).Offset(1)

        On Error GoTo 0
        .AutoFilter
    End With
End Sub

 

[Gliori]

Using that code copied all the data, but not the titles on row 1-3 and formulas on the last row. So there's something that needs to be changed in the code. Also the "MyTest" sheet has the standard appearance for sheets in Excel. If you understand what I mean? For example I have changed the width of some columns on the original sheet but on the new one they've gone back to "standard width".

And again, do you know if there's anyway to post the excel document here so that others can try codes in it? That would facilitate all this, haha [h=2][/h]

 

[MARK858]

You can move the filter to row 3 and unhide the last row and copy as values (assuming that you are copying).

Sub FiltTest2()
    Dim x As Long, y As Long, RESP1 As String, RESP2 As String, Shtx As Worksheet, LstRw As Long

    RESP1 = InputBox("Choose the number which represents the month you want to filter from.")
    RESP2 = InputBox("Choose the number which represents the month you want to filter to.")

    x = DateSerial(Year(Date), RESP1, 1)
    y = DateSerial(Year(Date), RESP2 + 1, 0)

    Set Shtx = ActiveSheet
    Worksheets.Add(After:=Worksheets(Worksheets.count)).Name = "MyTest"

    LstRw = Shtx.Range("A" & Rows.count).End(xlUp).Row
    With Shtx.Range("A3:R" & LstRw)
        .AutoFilter Field:=12, Criteria1:= _
                    ">=" & x, Operator:=xlAnd, Criteria2:="<=" & y
        On Error Resume Next
        Shtx.Rows(LstRw).Hidden = False
        .Offset(-2).Resize(.Rows.count + 3).SpecialCells(xlCellTypeVisible).Copy

        Sheets("MyTest").Range("A" & Rows.count).End(xlUp).Offset(1).PasteSpecial (xlValues)

        On Error GoTo 0
        .AutoFilter
    End With
End Sub

And again, do you know if there's anyway to post the excel document here so that others can try codes in it? That would facilitate all this, haha

No you can't post attachments here (you can post screenshots. See my signature block below for some links).

As a last resort you can put a file on a free file hosting site and post a link in the thread but the Moderators would prefer that you didn't do that.

 

[Gliori]

Hey! I used one of the links in your signature and came to this drop box website, not screenshot. But well I uploaded a piece of my file there so that I could share it, hope moderators don't mind too much?

My file (don't mind the Swedish hehe)

I tried the code you posted most recently and I still got the same problem with the width of columns as mentioned before. They go back to standard. And the sum formulas did not get copied. D*mn! I was so happy it seemed to work perfect previously, before I noticed these problems.. haha.

Well I'm really glad you're taking your time to help me with this issue, it's very much appreciated.

 

[MARK858]

Hopefully the code below will sort out the columns issue but as you will see you get ref errors in the formula as I suspected (BTW you never mentioned that the formulas were 3 rows below the data).

Is there any particular reason the formulas can't go into the destination sheet directly (and what are you trying to sum the columns in the original sheet or in the destination sheet)?

BTW the dropbox file is an Excel addin written by one of the forum moderators for pasting screenshots.

Sub FiltTest2()
    Dim x As Long, y As Long, RESP1 As String, RESP2 As String, Shtx As Worksheet, LstRw As Long

    RESP1 = InputBox("Choose the number which represents the month you want to filter from.")
    RESP2 = InputBox("Choose the number which represents the month you want to filter to.")

    x = DateSerial(Year(Date), RESP1, 1)
    y = DateSerial(Year(Date), RESP2 + 1, 0)

    Set Shtx = ActiveSheet
    Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "MyTest"

    LstRw = Shtx.Range("A" & Rows.Count).End(xlUp).Row
    With Shtx.Range("A3:R" & LstRw)
        .AutoFilter Field:=12, Criteria1:= _
                    ">=" & x, Operator:=xlAnd, Criteria2:="<=" & y
        On Error Resume Next
        Shtx.Rows(LstRw).Hidden = False
        .Offset(-2).Resize(.Rows.Count + 5).SpecialCells(xlCellTypeVisible).Copy

        With Sheets("MyTest").Range("A" & Rows.Count).End(xlUp).Offset(1)
            .PasteSpecial xlPasteColumnWidths
            .PasteSpecial
        End With

        On Error GoTo 0
        .AutoFilter
    End With

 

[Gliori]

Ok, we're (you're heh) getting there.

The problems now were that the last row of data was left untouched, even when I wrote 1 and 5 to get rid of June. The others from June disappeared, just as they should.
Also the sum formulas on the new sheet didn't work properly and only showed this: ######. It said =SUM(#REFERENCE!) (I think it's like that in English? I have excel in Swedish so I'm not sure)

Is there any particular reason the formulas can't go into the destination sheet directly (and what are you trying to sum the columns in the original sheet or in the destination sheet)?

I'm not sure what you mean exactly but the original intention was to filter depending on what you wrote in the input boxes, and then remove the data which was filtered. So the formulas would adjust to this automatically and now sum the remaining data. The code you wrote now instead copies the sheet and leaves only the data that I've selected (depending on what I write in the input boxes) on the new sheet. This is also fine. Now it's the new sheet that is interesting, so here I need the sum formulas. The original sheet is not interesting anymore and can be removed.

 

[MARK858]

[color=darkblue]Sub[/color] FiltTest3()
    [color=darkblue]Dim[/color] x [color=darkblue]As[/color] [color=darkblue]Long[/color], y [color=darkblue]As[/color] [color=darkblue]Long[/color], RESP1 [color=darkblue]As[/color] [color=darkblue]String[/color], RESP2 [color=darkblue]As[/color] [color=darkblue]String[/color], Shtx [color=darkblue]As[/color] Worksheet, LstRw [color=darkblue]As[/color] [color=darkblue]Long[/color]
    [color=darkblue]Dim[/color] LstRw2 [color=darkblue]As[/color] [color=darkblue]Long[/color], icol [color=darkblue]As[/color] Long


    RESP1 = InputBox("Choose the number which represents the month you want to filter from.")
    RESP2 = InputBox("Choose the number which represents the month you want to filter to.")

    x = DateSerial(Year(Date), RESP1, 1)
    y = DateSerial(Year(Date), RESP2 + 1, 0)

    [color=darkblue]Set[/color] Shtx = Blad1
    Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "MyTest"

    LstRw = Shtx.Range("C" & Rows.Count).End(xlUp).Row

    [color=darkblue]With[/color] Shtx.Range("A3:R" & LstRw)
        .AutoFilter Field:=12, Criteria1:= _
                    ">=" & x, Operator:=xlAnd, Criteria2:="<=" & y
        [color=darkblue]On[/color] [color=darkblue]Error[/color] [color=darkblue]Resume[/color] [color=darkblue]Next[/color]

        .Offset(-2).Resize(.Rows.Count + 3).SpecialCells(xlCellTypeVisible).Copy

        [color=darkblue]With[/color] Sheets("MyTest").Range("C" & Rows.Count).End(xlUp).Offset(1, -2)
            .PasteSpecial xlPasteColumnWidths
            .PasteSpecial
        [color=darkblue]End[/color] [color=darkblue]With[/color]

        [color=darkblue]On[/color] [color=darkblue]Error[/color] [color=darkblue]GoTo[/color] 0
        .AutoFilter
    [color=darkblue]End[/color] [color=darkblue]With[/color]

    [color=darkblue]With[/color] Sheets("MyTest")
        LstRw2 = .Cells(Rows.Count, "C").End(xlUp).Row
        [color=darkblue]For[/color] icol = 6 [color=darkblue]To[/color] 9
            .Cells(LstRw2 + 3, icol).Formula = "=SUM(" & .Range(.Cells(5, icol), .Cells(LstRw2, icol)).Address & ")"
        [color=darkblue]Next[/color]
        .Cells(LstRw2 + 3, 13).Formula = "=SUM(" & .Range(.Cells(5, 13), .Cells(LstRw2, 13)).Address & ")"
    [color=darkblue]End[/color] [color=darkblue]With[/color]
[color=darkblue]End[/color] [color=darkblue]Sub[/color]