Something wrong with multiple criteria filter macro

G

Gliori

New Member
Joined
Jun 15, 2015
Messages
32
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
 
Sort by date Sort by votes
Needs to have the filter the other way round try....

Rich (BB code): 
Sub FiltTest3ishB()
    Dim x As Long, y As Long, RESP1 As String, RESP2 As String, Shtx As Worksheet, LstRw As Long
    Dim LstRw2 As Long, icol 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.")

    Application.ScreenUpdating = False

    Set Shtx = Blad1

    With Shtx.Range("O4:O" & Shtx.Range("C" & Rows.Count).End(xlUp).Row)
        .FormulaR1C1 = "=MONTH(RC[-3])"
        .Value = .Value
        With .Offset(, 1)
            .FormulaR1C1 = "=YEAR(RC[-15])"
            .Value = .Value
        End With
    End With

    x = RESP1
    y = RESP2


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

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

    With Shtx.Range("A3:R" & LstRw)
    .AutoFilter Field:=16, Criteria1:="=2014", _
                    Operator:=xlOr, Criteria2:="=2015"
    
        .AutoFilter Field:=15, Criteria1:= _
                    ">=" & x, Operator:=xlAnd, Criteria2:="<=" & y
        
        On Error Resume Next

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

        With Sheets("MyTest").Range("C" & Rows.Count).End(xlUp).Offset(1, -2)
            .PasteSpecial xlPasteColumnWidths
            .PasteSpecial
        End With

        On Error GoTo 0
        .AutoFilter
    End With

    With Sheets("MyTest")
        LstRw2 = .Cells(Rows.Count, "C").End(xlUp).Row
        For icol = 6 To 9
            .Cells(LstRw2 + 3, icol).Formula = "=SUM(" & .Range(.Cells(5, icol), .Cells(LstRw2, icol)).Address & ")"
        Next
        .Cells(LstRw2 + 3, 13).Formula = "=SUM(" & .Range(.Cells(5, 13), .Cells(LstRw2, 13)).Address & ")"
        .Columns("N:O").Delete
    End With
    Blad1.Columns("O:P").Delete

    Application.ScreenUpdating = True
End Sub
 
Last edited:
Upvote 0
Cheers mate I will try it out asap!

Although I might not be able to post the result for a while. I'm on a cruise out in the ocean so I don't always have internet. I'll tell as soon as I'm able too. :)
 
Upvote 0
Alright... I now found out that I made a big mistake...

Noticed that I needed to change Set Shtx = Blad1 to Set Shtx = ActiveSheet :oops:

Well well. I got this one working fine now
Code: 
  Sub steg3()  'välj mellan vilka månader du vill se i fakt. dat. kolumnen
    Dim x As Long, y As Long, RESP1 As String, RESP2 As String, Shtx As Worksheet, LstRw As Long
    Dim LstRw2 As Long, icol As Long


    RESP1 = InputBox("Skriv in siffran som representerar den månad du vill filtrera FRÅN.")
    RESP2 = InputBox("Skriv in siffran som representerar den månad du vill filtrera TILL.")


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


    Set Shtx = ActiveSheet
    Worksheets.Add(after:=Worksheets("Faktura ordn.1")).Name = "Faktura ordn."
 LstRw = Shtx.Range("C" & Rows.Count).End(xlUp).Row
 With Shtx.Range("A3:R" & LstRw)
        .AutoFilter field:=12, Criteria1:= _
                    ">=" & x, Operator:=xlAnd, Criteria2:="<=" & y
        On Error Resume Next


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


        With Sheets("Faktura ordn.").Range("C" & Rows.Count).End(xlUp).Offset(0, -2)
            .PasteSpecial xlPasteColumnWidths
            .PasteSpecial
        End With


        On Error GoTo 0
        .AutoFilter
    End With


    With Sheets("Faktura ordn.")
        LstRw2 = .Cells(Rows.Count, "C").End(xlUp).Row
        For icol = 6 To 9
            .Cells(LstRw2 + 3, icol).Formula = "=SUM(" & .Range(.Cells(4, icol), .Cells(LstRw2, icol)).Address & ")"
        Next
        .Cells(LstRw2 + 3, 13).Formula = "=SUM(" & .Range(.Cells(4, 13), .Cells(LstRw2, 13)).Address & ")"
    End With
       Sheets("Faktura ordn.1").Select
    ActiveWindow.SelectedSheets.Delete
    Sheets("Faktura ordn.").Select
End Sub

Just need a small modification but can't figure out how to do that. I have sum formulas that need to be copied to the new sheet in column F, G, H, I, M, N. It's the N column that doesn't get copied to the new sheet, I don't think it was included in the excel file I shared with you so I geuss that's why.

I assume this is easy to change, but well, my "code-writing skills" are not the best :lookaway:

Thank you for all help by the way! It means a lot!

Kind regards.
 
Upvote 0
And also, when I press cancel I get an error message.

Is it possible to detect when a person presses cancel and then End sub. Again, my skills in VB just isn't enough...
 
Upvote 0
Gliori said:
EDIT: The column (N) gets copied ofc! But not the sum formula on the end row of the column.
Click to expand...
Isn't column N in the original sheet column M in the new one because of the hidden column now removed? I can't remember seeing a formula in N but can't check as on my phone but if you want a formula in N the ugly way is
Code: 
        .Cells(LstRw2 + 3, 14).Formula = "=SUM(" & .Range(.Cells(4, 14), .Cells(LstRw2, 14)).Address & ")"

As for the cancel bit that will have to wait until I am properly on the forum which might not be today.
 
Upvote 0
No you're right, there wasn't anything in the N column when the hidden column was removed on the file I shared with you. But on other worksheets that I'll use the code in there's an extra column with data, which is N.

I will try out the code when I get to my work place tomorrow, but I suppose there won't be any trouble.

Many thanks!
 
Upvote 0
Try (untested)...

Rich (BB code): 
Sub steg3()  'välj mellan vilka månader du vill se i fakt. dat. kolumnen
    Dim x As Long, y As Long, RESP1 As String, RESP2 As String, Shtx As Worksheet, LstRw As Long
    Dim LstRw2 As Long, icol As Long


    RESP1 = InputBox("Skriv in siffran som representerar den månad du vill filtrera FRÅN.")
    If StrPtr(RESP1) = 0 Then Exit Sub

    RESP2 = InputBox("Skriv in siffran som representerar den månad du vill filtrera TILL.")
    If StrPtr(RESP2) = 0 Then Exit Sub

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


    Set Shtx = ActiveSheet
    Worksheets.Add(after:=Worksheets("Faktura ordn.1")).Name = "Faktura ordn."
    LstRw = Shtx.Range("C" & Rows.count).End(xlUp).Row

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


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


        With Sheets("Faktura ordn.").Range("C" & Rows.count).End(xlUp).Offset(0, -2)
            .PasteSpecial xlPasteColumnWidths
            .PasteSpecial
        End With


        On Error GoTo 0
        .AutoFilter
    End With


    With Sheets("Faktura ordn.")
        LstRw2 = .Cells(Rows.count, "C").End(xlUp).Row
        For icol = 6 To 9
            .Cells(LstRw2 + 3, icol).Formula = "=SUM(" & .Range(.Cells(4, icol), .Cells(LstRw2, icol)).Address & ")"
        Next
        .Cells(LstRw2 + 3, 13).Formula = "=SUM(" & .Range(.Cells(4, 13), .Cells(LstRw2, 13)).Address & ")"
        .Cells(LstRw2 + 3, 14).Formula = "=SUM(" & .Range(.Cells(4, 14), .Cells(LstRw2, 14)).Address & ")"
    End With
    Sheets("Faktura ordn.1").Delete
    Sheets("Faktura ordn.").Select
End Sub
 
Upvote 0
Oh sorry, I forgot to reply you!

But well there were no troubles with this code, works excellent. Thanks a lot mate!

Cheers!
 
Upvote 0
Hello again!

Why does everything in the "Beställn.ordn."-sheet disappear when I use ("B" & Rows.Count) instead of ("C" & Rows.Count)?
I want the macro to put the SUM-formulas two rows below the last row in the B-column, but I can't seem to figure it out...

Is anyone out there willing to help? Please ask if there's something unclear, or if you don't understand what I want to do.

The code I use can be found below:

Code: 
'välj mellan vilka månader du vill se i fakt. dat. kolumnen    Dim x As Long, y As Long, RESP1 As String, RESP2 As String, Shtx As Worksheet, LstRw As Long
    Dim LstRw2 As Long, icol As Long


    RESP1 = InputBox("Skriv in siffran som representerar den månad du vill se data FRÅN (beställn. datum).                                                                                                                      Jan = 1,  Feb = 2,  Mar = 3,  etc...")
    If StrPtr(RESP1) = 0 Then Exit Sub
    RESP2 = InputBox("Skriv in siffran som representerar den månad du vill se data TILL (beställn. datum).                                                                                                                      Jan = 1,  Feb = 2,  Mar = 3,  etc...")
    If StrPtr(RESP2) = 0 Then Exit Sub
    
    x = DateSerial(Year(Date), RESP1, 1)
    y = DateSerial(Year(Date), RESP2 + 1, 0)


    Set Shtx = ActiveSheet
    Worksheets.Add(after:=Worksheets("Beställn.ordn.1")).Name = "Beställn.ordn."
 LstRw = Shtx.Range("B" & Rows.Count).End(xlUp).Row
 With Shtx.Range("A3:R" & LstRw)
        .AutoFilter Field:=1, Criteria1:= _
                    ">=" & x, Operator:=xlAnd, Criteria2:="<=" & y
        On Error Resume Next
        .Offset(-2).Resize(.Rows.Count + 3).SpecialCells(xlCellTypeVisible).Copy


        With Sheets("Beställn.ordn.").Range("B" & Rows.Count).End(xlUp).Offset(0, -2)
            .PasteSpecial xlPasteColumnWidths
            .PasteSpecial
        End With


        On Error GoTo 0
        .AutoFilter
    End With


    With Sheets("Beställn.ordn.")
        LstRw2 = .Cells(Rows.Count, "B").End(xlUp).Row
        For icol = 6 To 9
            .Cells(LstRw2 + 3, icol).Formula = "=SUM(" & .Range(.Cells(4, icol), .Cells(LstRw2, icol)).Address & ")"
        Next
        .Cells(LstRw2 + 3, 13).Formula = "=SUM(" & .Range(.Cells(4, 13), .Cells(LstRw2, 13)).Address & ")"
        .Cells(LstRw2 + 3, 14).Formula = "=SUM(" & .Range(.Cells(4, 14), .Cells(LstRw2, 14)).Address & ")"
    End With

Thank you in advance!
Kind regards.
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

G
  • Question Question
Excel macro for multiple filters (in a table)
Replies
4
Views
129
Alex Blakenburg
A
S
  • Question Question
AVERAGEIF TROUBLES
Replies
3
Views
167
AhoyNC
A
A
  • Solved
Select current month in combobox on userform for English language
2 3
Replies
29
Views
697
Ali M
A
G
  • Question Question
Sort (Z-A) Macro not working
Replies
1
Views
196
NateSC
NateSC
G
  • Question Question
Copy some specific columns whose header is merge
2 3
Replies
26
Views
740
Joe4
Joe4

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top