ShowAllData Error

[Squid1930]

Hi,

I have a macro that automatically creates a validation list depending on the cell to the left of it. The cell to the left is a category for a price list. The price list is on a separate worksheet, so the macro filters the price list, copies it to another worksheet (FilterSheet) and then creates the validation list from this.

The problem is that it works for rows above about 230 (this changes by a few rows) but doesn't work for rows below this.

The error is on the ps.ShowAllData

If I click Debug error then scroll to the top of the worksheet before clicking continue it then continues to work.

The code is

Sub Filter(sh As Worksheet, rn As String)
    


Application.ScreenUpdating = False


Dim fs As Worksheet
Dim ps As Worksheet
Dim lRow As Double


Set fs = Worksheets("FilterSheet")
Set ps = Worksheets("Price List")


lRow = ps.Cells(1, 2).End(xlDown).Row


ps.ListObjects("Table2").Range.AutoFilter Field:=9, Criteria1:=sh.Range(rn).Value


fs.Range("A1:A10000").ClearContents


ps.Range("B1:B" & lRow).Copy
fs.Range("A1").PasteSpecial xlPasteValues




If Not WorksheetFunction.CountA(fs.Range("A1:A10000")) = 1 Then


    Dim p As Integer
    
    p = fs.Cells(1, 1).End(xlDown).Row
    
    With sh.Range(rn).Offset(0, 1).Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="='FilterSheet'!$A$2:$A$" & p
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
Else
    With sh.Range(rn).Offset(0, 1).Validation
            .Delete
    End With
End If


'Application.Goto ps.Range("A1")
If ps.FilterMode Then
    ps.ShowAllData
End If
'Application.Goto sh.Range(rn).Offset(0, 1)


ps.Range("A1").Copy
Application.CutCopyMode = False


End Sub

If I include the Application.Goto before and after (currently commented out) then it works. So that is my work around for now but it doesn't address the problem.

I have recreated the problem on another worksheet with nothing but 2 entries, one on row 4 and another on row 330.
I can send it to anyone that wants to see it.

Thanks in advance
Sam