How to add one more filter to this VBA code?

[Aretradeser]

To this VBA code, I need to add one more filter, to choose from the data in Column 14, but I would like to be able to do it from a MsgBox. Is it possible?

Sub InformeDesplazmientoEspaña()
    On Error Resume Next
    m = MsgBox("¿QUIERE REALIZAR EL INFORME?", vbQuestion + vbYesNoCancel, "INFORME")
    If m = vbCancel Then Exit Sub
    Application.ScreenUpdating = False
    Sheets("INFORMES").Unprotect ("123")
    Sheets("BDATOS").Unprotect ("123")
    Sheets("BDATOS").Range("A1").AutoFilter Field:=7, Criteria1:="España"
    With Sheets("INFORMES")
        .Range("A2:L65536") = ""
        Sheets("BDATOS").Range("A2:L" & Sheets("BDATOS").Range("a65536").End(xlUp).Row).SpecialCells(xlCellTypeVisible).Copy _
        Destination:=.Range("A2")
        .Cells.FormatConditions.Delete
        .Range("A2:L" & .Range("a65536").End(xlUp).Row).Interior.ColorIndex = xlNone
    End With
    Sheets("BDATOS").Range("b1").AutoFilter = False
    Sheets("BDATOS").Protect ("123")
    'Application.ScreenUpdating = True
    Sheets("INFORMES").Select
    Ajustar
    Range("A1").Select
    Sheets("INFORMES").Protect ("123")
    MsgBox "INFORME REALIZADO", vbInformation + vbOKOnly, "INFORME"
    Exit Sub
End Sub

 

[GWteB]

I would go for an input box rather than a message box. See whether this works for you.

Replace this line:

    Sheets("BDATOS").Range("A1").AutoFilter Field:=7, Criteria1:="España"

with this snippet

    Dim Crit As String
    Crit = VBA.InputBox("Enter single criterion for column N", "AutoFilter")
    
    Sheets("BDATOS").Range("A1").AutoFilter Field:=7, Criteria1:="España"
    If Len(Crit) > 0 Then
        On Error Resume Next
        Sheets("BDATOS").Range("A1").AutoFilter Field:=14, Criteria1:=Crit
        If Err.Number > 0 Then
            MsgBox "Column N was not filtered" & vbNewLine & _
                   "(Error " & Err.Number & ": " & Err.Description & ")", vbExclamation, "Error on AutoFilter"
            Err.Clear
        End If
        On Error GoTo 0
    End If

 

[Aretradeser]

I would go for an input box rather than a message box. See whether this works for you.

Replace this line:

    Sheets("BDATOS").Range("A1").AutoFilter Field:=7, Criteria1:="España"

with this snippet

    Dim Crit As String
    Crit = VBA.InputBox("Enter single criterion for column N", "AutoFilter")
   
    Sheets("BDATOS").Range("A1").AutoFilter Field:=7, Criteria1:="España"
    If Len(Crit) > 0 Then
        On Error Resume Next
        Sheets("BDATOS").Range("A1").AutoFilter Field:=14, Criteria1:=Crit
        If Err.Number > 0 Then
            MsgBox "Column N was not filtered" & vbNewLine & _
                   "(Error " & Err.Number & ": " & Err.Description & ")", vbExclamation, "Error on AutoFilter"
            Err.Clear
        End If
        On Error GoTo 0
    End If

It throws error in the line of code that I mark you in red

Sub InformeDesplazmientoEspaña()
    On Error Resume Next
    m = MsgBox("¿QUIERE REALIZAR EL INFORME?", vbQuestion + vbYesNoCancel, "INFORME")
    If m = vbCancel Then Exit Sub
    Application.ScreenUpdating = False
    Sheets("INFORMES").Unprotect ("acuario3511")
    Sheets("BDATOS").Unprotect ("acuario3511")
        Dim Crit As String
    Crit = VBA.InputBox("Enter single criterion for column N", "AutoFilter")
    
    Sheets("BDATOS").Range("A1").AutoFilter Field:=7, Criteria1:="España"
    If Len(Crit) > 0 Then
        On Error Resume Next
        Sheets("BDATOS").Range("A1").AutoFilter Field:=14, Criteria1:=Crit
        If Err.Number > 0 Then
            MsgBox "Column N was not filtered" & vbNewLine & _
                   "(Error " & Err.Number & ": " & Err.Description & ")", vbExclamation, "Error on AutoFilter"
            Err.Clear
        End If
        On Error GoTo 0
    End If
    With Sheets("INFORMES")
        .Range("A2:L65536") = ""
        Sheets("BDATOS").Range("A2:L" & Sheets("BDATOS").Range("a65536").End(xlUp).Row).SpecialCells(xlCellTypeVisible).Copy _
        Destination:=.Range("A2")
        .Cells.FormatConditions.Delete
        .Range("A2:L" & .Range("a65536").End(xlUp).Row).Interior.ColorIndex = xlNone
    End With
    Sheets("BDATOS").Range("b1").AutoFilter = False ' ERROR
    Sheets("BDATOS").Protect ("acuario3511")
    'Application.ScreenUpdating = True
    Sheets("INFORMES").Select
    Ajustar
    Range("A1").Select
    Sheets("INFORMES").Protect ("acuario3511")
    MsgBox "INFORME REALIZADO", vbInformation + vbOKOnly, "INFORME"
    Exit Sub
End Sub

 

[Aretradeser]

I have deleted the line and it works

 

[GWteB]

It throws error in the line of code that I mark you in red

I didn't test your code, just have limited myself to your query. Remove the red line, I think it should work.

 

[Aretradeser]

I have deleted the line and it works

I RECTIFY: The filter remains fixed in the Sheet "BDATOS", it does not eliminate it.

 

[GWteB]

I see, try changing this

Sheets("BDATOS").Range("b1").AutoFilter = False ' ERROR

into this

Sheets("BDATOS").AutoFilterMode = False

 

[Aretradeser]

I see, try changing this

Sheets("BDATOS").Range("b1").AutoFilter = False ' ERROR

into this

Sheets("BDATOS").AutoFilterMode = False

Now it works correctly. Is it possible to do the same with the Commune 7 filter, to choose it also through a MsgBox, in the same VBA code?

 

[Aretradeser]

GWteB, thank you very much for your invaluable help.

 

[GWteB]

You are welcome and thanks for the feedback

Is it possible to do the same with the Commune 7 filter, to choose it also through a MsgBox, in the same VBA code?

Yes, just copy the code of my post #2, declare an extra variable and change some arguments of the AutoFilter method accordingly:

    Dim Crit7 As String, Crit14 As String
    
    Crit7 = VBA.InputBox("Enter single criterion for column H", "AutoFilter")
    Crit14 = VBA.InputBox("Enter single criterion for column N", "AutoFilter")
    
    If Len(Crit7) > 0 Then
        On Error Resume Next
        Sheets("BDATOS").Range("A1").AutoFilter Field:=7, Criteria1:=Crit7
        If Err.Number > 0 Then
            MsgBox "Column H was not filtered" & vbNewLine & _
                   "(Error " & Err.Number & ": " & Err.Description & ")", vbExclamation, "Error on AutoFilter"
            Err.Clear
        End If
        On Error GoTo 0
    End If
    
    If Len(Crit14) > 0 Then
        On Error Resume Next
        Sheets("BDATOS").Range("A1").AutoFilter Field:=14, Criteria1:=Crit14
        If Err.Number > 0 Then
            MsgBox "Column N was not filtered" & vbNewLine & _
                   "(Error " & Err.Number & ": " & Err.Description & ")", vbExclamation, "Error on AutoFilter"
            Err.Clear
        End If
        On Error GoTo 0
    End If