Error occured during running for loop in filter-CodePudding

Am using this belowenter code here code to apply filter and copying the filtered values in the next sheet it is working fine when i have multiple values to filter, when i put single value it is causing an error in the for loop "For Each x In arNames".Can anyone Please help me to get out this issue.Thanks in advance.

Sub splittinggroupsheets()
Dim rng As Range, rngCopy As Range, x, arNames
Dim last As Long, sht As String, n As Long
sht = "Sheet1"



' filter on column A
With Sheets(sht)
.AutoFilterMode = False

last = .Cells(Rows.Count, "A").End(xlUp).Row
Set rng = .Range("A1:F" & last)
.Columns("AA:AA").Clear
.Range("A1:A" & last).AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=.Range("AA1"), Unique:=True
last = .Cells(Rows.Count, "AA").End(xlUp).Row

' list of filter names
arNames = .Range("AA2:AA" & last).Value
.Columns("AA:AA").Clear
End With

Application.ScreenUpdating = False

' aply filter for each name
For Each x In arNames

With rng
.AutoFilter
.AutoFilter field:=1, Criteria1:=x
Set rngCopy = .SpecialCells(xlCellTypeVisible)
End With

Sheets.Add(after:=Sheets(Sheets.Count)).Name = x
rngCopy.Copy
ActiveSheet.Paste
ActiveSheet.Range("A1").Select
n = n   1

Next x

' Turn off filter
Sheets(sht).AutoFilterMode = False
Sheets(sht).Activate

With Application
.CutCopyMode = False
.ScreenUpdating = True
End With
'MsgBox n & " sheets created", vbInformation
End Sub

CodePudding user response：

Single cells don't create an array so you have to do it explicitly.

        ' list of filter names
        If last = 2 Then
            ReDim arNames(1 To 1, 1 To 1)
            arNames(1, 1) = .Range("AA2").Value
        Else
            arNames = .Range("AA2:AA" & last).Value
        End If