How to copy using multiple filters from user input data in Excel VBA

Question

I would like to get more than 1 input from the user through the input field and filter the table. Only one column is filtered. Then copy all the row data to another sheet. I used the code below. The problem is that it can be used to filter 1 country.

I have many countries in column F. I need to enter 2 or more countries in the input field. Then copy and paste. I would like to add a Loop. But I do not know how to do this. help me

Private Sub CommandButton1_Click()

Dim str1 As Variant
Dim Tbl As ListObject
Dim FiltRng As Range
Dim RngArea As Range

Set Tbl = Sheet1.ListObjects("DataTable")
str1 = Application.InputBox("Select the Country Code")

If str1 = False Then
    MsgBox "Please select one Country", , "Input"
Exit Sub

Else

Tbl.Range.AutoFilter Field:=6, Criteria1:=str1
For Each RngArea In Tbl.Range.SpecialCells(xlCellTypeVisible).Rows

If RngArea.Row > 1 Then
    If Not FiltRng Is Nothing Then
        Set FiltRng = Application.Union(FiltRng, RngArea)
    Else
        Set FiltRng = RngArea
    End If
End If

Next RngArea

If Not FiltRng Is Nothing Then
FiltRng.Copy Sheets("Sheet2").Range("A2")
End If

End If

Sheet1.ListObjects("DataTable").Range.AutoFilter Field:=6

End Sub

Answer 1

You can read from the InputBox in a loop. Try the following code.

Sub Macro3()
    Dim arr() As String
    Dim size As Long
    size = 1

    Do
        str1 = Application.InputBox("Select the Country Code")

        ReDim Preserve arr(size)
        arr(size) = str1
        size = size + 1
    Loop While (str1 <> vbNullString) And (str1 <> False)

    ActiveSheet.Range("$A$1:$F$5").AutoFilter Field:=6, Criteria1:=arr, Operator:=xlFilterValues
End Sub

Answer 2

, , , ? VBA.

Answer 3

Use the following subsection, which takes two criteria to filter the table and copy the filtered data onto sheet2. You can add more criteria as needed.

Sub Filter2Criteria()
Dim str1, str2 As Variant
Dim Tbl As ListObject
Dim FiltRng As Range
Dim RngArea As Range

    Set Tbl = Sheet1.ListObjects("DataTable")

    str1 = Application.InputBox("Select the Country Code")
    str2 = Application.InputBox("Select the Country Code")

    If str1 = False Then
        MsgBox "Please select first Country", , "Input"
          Exit Sub
          ElseIf str2 = False Then
         MsgBox "Please select second Country", , "Input"
        Exit Sub
    End If

    Tbl.Range.AutoFilter Field:=6, Criteria1:=str1, Operator:=xlOr, Criteria2:=str2

    Set FiltRng = Tbl.Range.SpecialCells(xlCellTypeVisible)
    FiltRng.Copy Sheets("Sheet2").Range("A2")

End Sub