aSwiftSolution
New Member
- Joined
- Aug 13, 2015
- Messages
- 19
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
Full Route:
Run-time error '1004':
Application-defined or object-defined error
Snippet: *Debug highlight in bold
Code:
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 WithFull Route:
Code:
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
