How do I modify this vba code?

Aretradeser

Board Regular
Joined
Jan 16, 2013
Messages
173
Office Version
  1. 2013
Platform
  1. Windows
By kindness of the forum member GWteB, I was provided with the VBA code, that I put below, in which he included some lines of code to be able to choose, through a InputBox, a filter for Column 14.
This code allows me to choose a value of this column to filter, but when I need to filter by several of its values or all of them, it does not help me.
Could I add a line of code to this InputBox that allows me to do this, to choose several values to filter, even all?

Rich (BB code):
Sub InformeDesplazmientoEspaña()
    On Error Resume Next
    m = MsgBox("¿YOU WANT TO MAKE THE REPORT?", vbQuestion + vbYesNoCancel, "INFORME")
    If m = vbCancel Then Exit Sub
    Application.ScreenUpdating = False
    Sheets("INFORMES").Unprotect ("123")
    Sheets("BDATOS").Unprotect ("123")
        Dim Crit As String
    Crit = VBA.InputBox("Enter single criterion for column N", "AutoFilter")
    
    Sheets("BDATOS").Range("A1").AutoFilter Field:=7, Criteria1:="Spain"
    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").AutoFilterMode = 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
 

Excel Facts

Format cells as date
Select range and press Ctrl+Shift+3 to format cells as date. (Shift 3 is the # sign which sort of looks like a small calendar).

shknbk2

Well-known Member
Joined
Mar 5, 2016
Messages
561
Office Version
  1. 365
Platform
  1. Windows
Here's a first try. The InputBox get a comma string separating the columns and criteria. Since the code had column G and "Spain" as the first filter, I commented out that line and put it in the InputBox instead as default text. Additional filtering can be added after "Spain". For example, you could enter
Rich (BB code):
G,Spain,N,Value
I don't know what you have in N, so Value is generic. The code makes an array from the text and separates the items by the comma. In this example, the array would have 4 values: 1) G, 2) Spain, 3) N, and 4) Value. You can add even more columns.

Without more, the criteria values 2) and 4) in the InputBox text will find/filter cells based on the whole cell text being equal to the values. That is, only cells with "Spain" and "Value" as the whole cell text will be left after the filter. If the values in N contain "Value" but don't have that as the whole text, you could use this as an example to sort E by whole cell = "Spain" and N by contains "Value"
Rich (BB code):
G,Spain,N,=*Value*
VBA Code:
Sub InformeDesplazmientoEspaña()
    On Error Resume Next
    m = MsgBox("¿YOU WANT TO MAKE THE REPORT?", vbQuestion + vbYesNoCancel, "INFORME")
    If m = vbCancel Then Exit Sub
    Application.ScreenUpdating = False
    Sheets("INFORMES").Unprotect ("123")
    Sheets("BDATOS").Unprotect ("123")
    
    Dim Crit As String
    Dim aArray As Variant
    Dim iArray As Integer
    
    Crit = InputBox("Enter criteria in pairs (for example: G,Criteria1Text,N,Criteria2Text", "AutoFilter", "G,Spain")
    
'    Sheets("BDATOS").Range("A1").AutoFilter Field:=7, Criteria1:="Spain"
    If Len(Crit) > 0 Then
        On Error Resume Next
        aArray = Split(Crit, ",")
        For iArray = 0 To UBound(aArray) Step 2
            If Len(aArray(iArray)) > 0 And Len(aArray(iArray + 1)) > 0 Then
                Sheets("BDATOS").Range("A1").AutoFilter Field:=Range(aArray(iArray) & ":" & aArray(iArray)).Column, Criteria1:=aArray(iArray + 1)
                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
            End If
        Next
        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").AutoFilterMode = 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
 

Forum statistics

Threads
1,175,965
Messages
5,900,589
Members
434,836
Latest member
YetAnotherDave

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
Top