Strange Listobject behaviour

[aSwiftSolution]

Hi all, hope some one can help. Recently I have begun working with ListObjects, handy things definitely but they seem temperamental. In my current project i have a handful of them to store lists of data, my code seems to manage them well adding entries, removing entries etc but after around 6 or 7 iterations of a process excel throws up an error. The example below has just run perfectly 4 times then thrown up an error on the 5th iteration, any help would be greatly appreciated.

Run-time error '1004':
Application-defined or object-defined error

Snippet: *Debug highlight in bold

        With tmpTable
            Select Case .ListRows.Count
                Case Is = 0
                    Set rng_TargetRow = .InsertRowRange
                Case Else
                    If WorksheetFunction.CountA(.ListRows(.ListRows.Count).Range) > 0 Then
                        Set rng_Prt1 = Cells(.HeaderRowRange.Row, .ListColumns(1).Range.Column)
                        Set rng_Prt2 = Cells(.ListRows(.ListRows.Count).Range.Row + 1, .ListColumns(.ListColumns.Count).Range.Column)
                        [SIZE=3][I][B][U].Resize Range(rng_Prt1, rng_Prt2)[/U][/B][/I][/SIZE]
                    End If
                    Set rng_TargetRow = .ListRows(.ListRows.Count).Range
            End Select
        End With

Full Route:

Sub AllocationMgr_TransferIn(ByVal TargetArea As String, ByVal TargetGame As String)
'---------------------------------------------------------------------------------------
' Procedure : AllocationMgr_TransferIn
' Author    : 
' Date      : 18/11/2015
' Purpose   : To take a default game, index it, then allocate to the chosen area
'---------------------------------------------------------------------------------------
Dim tmpTable As ListObject

Dim rng_TargetRow As Range, _
    rng_Prt1 As Range, _
    rng_Prt2 As Range

Dim LoopIndex As Byte, _
    GameIndex As Integer
    
Dim IndexedGame_str As String

Dim Unique As Boolean
    
    If ErrHandling = True Then On Error GoTo ErrHandler Else On Error GoTo 0
    
    '//Generate an indexed name of the default game
    GameIndex = 1
    Do Until Unique = True
        IndexedGame_str = TargetGame & " (" & GameIndex & ")"
        'If WorksheetFunction.CountIf(IndexedGames_tbl.ListColumns(1).DataBodyRange, IndexedGame_str) = 0 Then
        If WorksheetFunction.CountIf(Range(IndexedGames_tbl.Name & "[#Data]"), IndexedGame_str) = 0 Then
            Unique = True
        Else
            Unique = False
            GameIndex = GameIndex + 1
        End If
    Loop
    
    '//Add to IndexedGames_tbl & SingleAllocation_tbl
    For LoopIndex = 1 To 2
        Select Case LoopIndex
            Case 1
                Set tmpTable = Sheet2.ListObjects(IndexedGames_tbl.Name)
            Case 2
                Set tmpTable = Sheet2.ListObjects(SingleA_tbl.Name)
        End Select
        
        With tmpTable
            Select Case .ListRows.Count
                Case Is = 0
                    Set rng_TargetRow = .InsertRowRange
                Case Else
                    If WorksheetFunction.CountA(.ListRows(.ListRows.Count).Range) > 0 Then
                        Set rng_Prt1 = Cells(.HeaderRowRange.Row, .ListColumns(1).Range.Column)
                        Set rng_Prt2 = Cells(.ListRows(.ListRows.Count).Range.Row + 1, .ListColumns(.ListColumns.Count).Range.Column)
                        .Resize Range(rng_Prt1, rng_Prt2)
                    End If
                    Set rng_TargetRow = .ListRows(.ListRows.Count).Range
            End Select
        End With
        
        rng_TargetRow.Cells(1, 1).Value = IndexedGame_str
        
        Call SortTable(TargetTable:=tmpTable, KeyRng1:=tmpTable.ListColumns(1).DataBodyRange)
        tmpTable.HeaderRowRange.EntireColumn.AutoFit
        
    Next LoopIndex
    
    '//Add to GroupAllocation
    Call Sync_AllocationTables(Single2Group:=True, TargetArea:=TargetArea)
    Call AllocationMgr_ListBox_Link
    
ExitRoute:

    Set tmpTable = Nothing
    Set rng_Prt1 = Nothing
    Set rng_Prt2 = Nothing
    Set rng_TargetRow = Nothing
    
    On Error GoTo 0
    Exit Sub
    
ErrHandler:
    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure AllocationMgr_TransferIn of Module F13_AllocationMgr"
End Sub

 

[aSwiftSolution]

No worries, i know it was a big ask, thank you help so far anyway. Well I've nearly finished the re-write, giving each table its own worksheet and declaring all 5 listobjects as public variables (as these routines are within 3 different modules) on the initial startup procedure. Fingers crossed.

 

[aSwiftSolution]

May (or may not) have found something, on 2 routines where a declared listobject was passed it was done ByVal rather than ByRef, could this have caused the instability?

 

[Jerry Sullivan]

FWIW, I've seen inconsistent results when dealing with a Table (ListObject) that is specified to try to have 0 or 1 row of data under the header. The ResetTable procedure is trying to delete the data rows and leave which would leave just the header. Excel wants the table to have at least one data row. Typically, it will just add that row back in, but that's a part that can be inconsistent.

 

[aSwiftSolution]

Thank you for the input Jerry, I'll try amending the ResetTable routine to clear the table of entries then resize it to only 1 row.

 

[Domenic]

FWIW, I've seen inconsistent results when dealing with a Table (ListObject) that is specified to try to have 0 or 1 row of data under the header. The ResetTable procedure is trying to delete the data rows and leave which would leave just the header. Excel wants the table to have at least one data row. Typically, it will just add that row back in, but that's a part that can be inconsistent.

Yeah, that must be it. Good to know. Thanks Jerry!

 

[aSwiftSolution]

Domenic, Jerry, thank you very much, the re-write has just run 22 iterations without error. A lot got changed in the re-write (mostly through paranoia), the ListObjects were reduced to a single public declaration made in the initial routine, only 2 routines now use passed objects and these are ByRef, each table has its own worksheet (which will be the first thing i try to change back to all on 1), lots of additional listrows & databodyrange checks and of course the amended ResetTable routine. Thanks again your both legends.

Sub ResetTable(ByRef TargetTable As ListObject)
'---------------------------------------------------------------------------------------
' Procedure : ResetTable
' Author    :
' Date      : 20/11/2015
' Purpose   : To reset any targeted table
'---------------------------------------------------------------------------------------

    '//Invoke error handling
    If ErrHandling = True Then On Error GoTo ErrHandler Else On Error GoTo 0
    
    '//Ensure table comprises of 1 blank row
    With TargetTable
        Select Case .ListRows.Count
            Case Is = 0
                .ListRows.Add
            Case Is = 1
                .DataBodyRange.ClearContents
            Case Is > 1
                .DataBodyRange.ClearContents
                .Resize .Range.Resize(2)
        End Select
    End With
    
    On Error GoTo 0
    Exit Sub
    
ErrHandler:
    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure ResetTable of Module Y2_Misc_Table"
End Sub

 

[Domenic]

It's interesting, though, once you clear the contents and resize the table, Excel still considers the number of listrows to be 0. I guess that's because the first row (after the header row) doesn't contain data. In any case, I'm glad you've been able to work it out.

Cheers!