vba array autofilter code not working

[Dancarro]

Hi,

I have a vba code which autofilters an array of countries, and this works fine.

The only problems is that when a country is missing from the country column the vba code stops working. I would like some help in the code so that the code can move to the next country of the array filter.
Note: In some occasions there is no data for the country.

The code I have is the following:

Sub FilterCountry()
Dim sh As Worksheet, ws As Worksheet
Dim Wb As Workbook
Dim LstR As Long, i As Long
Dim Rng As Range
Dim Pth As String
Dim Ary As Variant


Pth = "H:\Version 6"
Ary = Array("Austria", "Austria.xlsm", "Country Billing Report", "Belgium", "Belgium.xlsm", "Country Billing Report", "Bulgaria", "Bulgaria.xlsm", "Country Billing Report", "Croatia", "Croatia.xlsm", "Country Billing Report")
Set sh = Sheets("Country report") 'set the sheet to filter
LstR = sh.Cells(sh.Rows.Count, "A").End(xlUp).Row 'find last row

For i = 0 To UBound(Ary) Step 3
Set Wb = Workbooks.Open(Pth & Ary(i + 1))
Set ws = Wb.Sheets(Ary(i + 2))
Application.ScreenUpdating = False
With sh 'do something with the sheet
.Range("A3:Y3").AutoFilter Field:=5, Criteria1:=Ary(i)
Set Rng = .Range("A4:Y" & LstR).SpecialCells(xlCellTypeVisible) 'Replace Z with correct last column
Rng.Copy ws.Cells(ws.Rows.Count, "A").End(xlUp).Offset(1)
.AutoFilterMode = False
End With
Wb.Close True
Next i


End Sub

Many thanks,
Dan

 

[DanteAmor]

Try this

Sub FilterCountry()
    Dim sh As Worksheet, ws As Worksheet
    Dim Wb As Workbook
    Dim LstR As Long, i As Long
    Dim Rng As Range
    Dim Pth As String
    Dim Ary As Variant
    
    Pth = "H:\Version 6"
    Ary = Array("Austria", "Austria.xlsm", "Country Billing Report", _
                "Belgium", "Belgium.xlsm", "Country Billing Report", _
                "Bulgaria", "Bulgaria.xlsm", "Country Billing Report", _
                "Croatia", "Croatia.xlsm", "Country Billing Report")
    Set sh = Sheets("Country report") 'set the sheet to filter
    LstR = sh.Cells(sh.Rows.Count, "A").End(xlUp).Row 'find last row
    
    For i = 0 To UBound(Ary) Step 3
        Set Wb = Workbooks.Open(Pth & Ary(i + 1))
        Set ws = Wb.Sheets(Ary(i + 2))
        Application.ScreenUpdating = False
        With sh 'do something with the sheet
            .Range("A3:Y3").AutoFilter Field:=5, Criteria1:=Ary(i)
[COLOR=#ff0000]            LstR = sh.Cells(sh.Rows.Count, "A").End(xlUp).Row 'find last row[/COLOR]
[COLOR=#ff0000]            If LstR > 3 Then[/COLOR]
                Set Rng = .Range("A4:Y" & LstR).SpecialCells(xlCellTypeVisible) 'Replace Z with correct last column
                Rng.Copy ws.Cells(ws.Rows.Count, "A").End(xlUp).Offset(1)
[COLOR=#ff0000]            End If[/COLOR]
            .AutoFilterMode = False
        End With
        Wb.Close True
    Next i
End Sub

 

[Fluff]

Another option

      With sh 'do something with the sheet
         .Range("A3:Y3").AutoFilter Field:=5, Criteria1:=Ary(i)
         .AutoFilter.Range.Offset(1).Copy ws.Cells(ws.Rows.Count, "A").End(xlUp).Offset(1)
         .AutoFilterMode = False
      End With

 

[Dancarro]

Hi Dante Amor,

I have a debug on this line:
Set Wb = Workbooks.Open(Pth & Ary(i + 1))

As I don't have data for Belgium, it stops here and it highlights in yellow the above line.

Is there anyway to code that if goes to the next country

Regards,
Dan

 

[DanteAmor]

Hi Dante Amor,

I have a debug on this line:
Set Wb = Workbooks.Open(Pth & Ary(i + 1))

As I don't have data for Belgium, it stops here and it highlights in yellow the above line.

Is there anyway to code that if goes to the next country

Regards,
Dan

Try this

Sub FilterCountry()
    Dim sh As Worksheet, ws As Worksheet
    Dim Wb As Workbook
    Dim LstR As Long, i As Long
    Dim Rng As Range, Ary As Variant
    Dim Pth As String, [COLOR=#ff0000]nBook As String[/COLOR]
    
    Pth = "H:\Version 6"
    Ary = Array("Austria", "Austria.xlsm", "Country Billing Report", _
                "Belgium", "Belgium.xlsm", "Country Billing Report", _
                "Bulgaria", "Bulgaria.xlsm", "Country Billing Report", _
                "Croatia", "Croatia.xlsm", "Country Billing Report")
    Set sh = Sheets("Country report") 'set the sheet to filter
    LstR = sh.Cells(sh.Rows.Count, "A").End(xlUp).Row 'find last row
    
    For i = 0 To UBound(Ary) Step 3
[COLOR=#ff0000]        nBook = Pth & Ary(i + 1)[/COLOR]
[COLOR=#ff0000]        If Dir(nBook) <> "" Then[/COLOR]
            Set Wb = Workbooks.Open(Pth & Ary(i + 1))
            Set ws = Wb.Sheets(Ary(i + 2))
            Application.ScreenUpdating = False
            With sh 'do something with the sheet
                .Range("A3:Y3").AutoFilter Field:=5, Criteria1:=Ary(i)
                LstR = sh.Cells(sh.Rows.Count, "A").End(xlUp).Row 'find last row
                If LstR > 3 Then
                    Set Rng = .Range("A4:Y" & LstR).SpecialCells(xlCellTypeVisible) 'Replace Z with correct last column
                    Rng.Copy ws.Cells(ws.Rows.Count, "A").End(xlUp).Offset(1)
                End If
                .AutoFilterMode = False
            End With
            Wb.Close True
[COLOR=#ff0000]        End If[/COLOR]
    Next i
End Sub

 

[Fluff]

How about

Sub FilterCountry()
   Dim sh As Worksheet, ws As Worksheet
   Dim Wb As Workbook
   Dim LstR As Long, i As Long
   Dim Rng As Range
   Dim Pth As String
   Dim Ary As Variant
   
   
   Pth = "H:\Version 6"
   Ary = Array("Austria", "Austria.xlsm", "Country Billing Report", "Belgium", "Belgium.xlsm", "Country Billing Report", "Bulgaria", "Bulgaria.xlsm", "Country Billing Report", "Croatia", "Croatia.xlsm", "Country Billing Report")
   Set sh = Sheets("Country report") 'set the sheet to filter
   LstR = sh.Cells(sh.Rows.Count, "A").End(xlUp).Row 'find last row
   
   For i = 0 To UBound(Ary) Step 3
      Set Wb = Nothing
      On Error Resume Next
      Set Wb = Workbooks.Open(Pth & Ary(i + 1))
      On Error GoTo 0
      If Not Wb Is Nothing Then
         Set ws = Wb.Sheets(Ary(i + 2))
         Application.ScreenUpdating = False
         With sh 'do something with the sheet
            .Range("A3:Y3").AutoFilter Field:=5, Criteria1:=Ary(i)
            .AutoFilter.Range.Offset(1).Copy ws.Cells(ws.Rows.Count, "A").End(xlUp).Offset(1)
            .AutoFilterMode = False
         End With
         Wb.Close True
      End If
   Next i
End Sub

 

[Dancarro]

Hi Fluff and Dante Amor,

Fluff your last code worked perfectly, fantastic.

@ Dante Amor: I tried your code too but nothing really happened. It was looping from nBook to Next i, and so on

I would like to thank you both for your help, much appreciated your assistance.

Kind Regards,
Dan

 

[Fluff]

You're welcome & thanks for the feedback

 

[DanteAmor]

The backslash is missing

[COLOR=#333333]Pth = "H:\Version 6[/COLOR][B][COLOR=#ff0000]\[/COLOR][/B][COLOR=#333333]"[/COLOR]