AnotherExcelGuy
New Member
- Joined
- Jul 8, 2019
- Messages
- 13
Hi all,
Having some trouble and not sure what to try next. I'm getting the following run time error on other people's computers but it works fine on mine: '-2147417848 (80010108)': Method 'Add' of object 'ListRows' failed
Here's my code, please excuse the rough coding as I'm very new at this and this took me a long time to figure out. I put this under a 'Module'
Any help would be greatly appreciated - thank you!
Having some trouble and not sure what to try next. I'm getting the following run time error on other people's computers but it works fine on mine: '-2147417848 (80010108)': Method 'Add' of object 'ListRows' failed
Here's my code, please excuse the rough coding as I'm very new at this and this took me a long time to figure out. I put this under a 'Module'
Code:
Option Explicit
Sub CreateProjects()
' Dim lCount As Integer
Dim lMonthCount As Integer
Dim x As Integer, xProjects As Integer
Dim lNewRow As ListRow
Dim lProjectsCount As Integer
FreezeApp
Sheets("Data Entry").Visible = True
ClearTable
lMonthCount = DateDiff("m", ThisWorkbook.Sheets("Projects").Range("G2"), ThisWorkbook.Sheets("Projects").Range("h2"))
lProjectsCount = GetAllTableRows("Projects", "tbProjects")
For xProjects = 2 To lProjectsCount + 1
' Header
Set lNewRow = ThisWorkbook.Sheets("Data Entry").ListObjects("Table14").ListRows.Add
lNewRow.Range(1) = ThisWorkbook.Sheets("Projects").Range("A" & xProjects)
lNewRow.Range(3) = ThisWorkbook.Sheets("Projects").Range("C" & xProjects)
lNewRow.Range(2) = ThisWorkbook.Sheets("Projects").Range("B" & xProjects)
lNewRow.Range(4) = ThisWorkbook.Sheets("Projects").Range("D" & xProjects)
lNewRow.Range(5) = ThisWorkbook.Sheets("Projects").Range("E" & xProjects)
lNewRow.Range(6) = ThisWorkbook.Sheets("Projects").Range("F" & xProjects)
lNewRow.Range(9) = ThisWorkbook.Sheets("Projects").Range("G" & xProjects)
lNewRow.Range(10) = ThisWorkbook.Sheets("Projects").Range("H" & xProjects)
lNewRow.Range(13) = ThisWorkbook.Sheets("Projects").Range("F" & xProjects)
lNewRow.Range(15) = ThisWorkbook.Sheets("Projects").Range("G" & xProjects)
lNewRow.Range(16) = ThisWorkbook.Sheets("Projects").Range("H" & xProjects)
lNewRow.Range(22) = ThisWorkbook.Sheets("Projects").Range("I" & xProjects)
lNewRow.Range(23) = ThisWorkbook.Sheets("Projects").Range("J" & xProjects)
lMonthCount = DateDiff("m", ThisWorkbook.Sheets("Projects").Range("G" & xProjects), ThisWorkbook.Sheets("Projects").Range("H" & xProjects))
For x = 1 To lMonthCount
Set lNewRow = ThisWorkbook.Sheets("Data Entry").ListObjects("Table14").ListRows.Add
lNewRow.Range(1) = ThisWorkbook.Sheets("Projects").Range("A" & xProjects)
lNewRow.Range(3) = ThisWorkbook.Sheets("Projects").Range("C" & xProjects)
lNewRow.Range(2) = ThisWorkbook.Sheets("Projects").Range("B" & xProjects)
lNewRow.Range(4) = ThisWorkbook.Sheets("Projects").Range("D" & xProjects)
lNewRow.Range(5) = ThisWorkbook.Sheets("Projects").Range("E" & xProjects)
lNewRow.Range(6) = ThisWorkbook.Sheets("Projects").Range("F" & xProjects)
lNewRow.Range(9) = ThisWorkbook.Sheets("Projects").Range("G" & xProjects)
lNewRow.Range(10) = ThisWorkbook.Sheets("Projects").Range("H" & xProjects)
lNewRow.Range(13) = -1 * ThisWorkbook.Sheets("Projects").Range("F" & xProjects) / lMonthCount
lNewRow.Range(22) = ThisWorkbook.Sheets("Projects").Range("I" & xProjects)
lNewRow.Range(23) = ThisWorkbook.Sheets("Projects").Range("J" & xProjects)
Next x
Next xProjects
' lCount = GetAllTableRows("Data Entry", "Table14")
' ThisWorkbook.Sheets("Data Entry").ListObjects("Table14").ListRows.Add(
' lNewRow.Range(14) = "=SUM($N$3:N3)"
ThisWorkbook.Sheets("Data Entry").ListObjects("Table14").ListRows(1).Range(14).FormulaArray = "=IF(RC[-1]="""","""",SUM(R3C14:RC[-1]))"
ThisWorkbook.Sheets("Data Entry").ListObjects("Table14").ListRows(1).Range(19).FormulaArray = "=IF(RC[-1]="""","""",SUM(R3C19:RC[-1]))"
Sheets("Data Entry").Visible = False
UnFreezeApp
ActiveWorkbook.RefreshAll
End Sub
Function GetTableRows(pSheet As String, pTableName As String) As Integer
'GetTableRows = pSheet.ListObjects(pTableName).Range.Rows.Count - 1
GetTableRows = ThisWorkbook.Sheets(pSheet).ListObjects(pTableName).Range.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1
End Function
Function GetAllTableRows(pSheet As String, pTableName As String) As Integer
GetAllTableRows = ThisWorkbook.Sheets(pSheet).ListObjects(pTableName).Range.Columns.Rows.Count - 1
End Function
Private Sub FreezeApp()
Application.ScreenUpdating = False
End Sub
Private Sub UnFreezeApp()
Application.ScreenUpdating = True
End Sub
Private Sub ClearTable()
Sheets("Data Entry").Select
Rows("3:3").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Delete Shift:=xlUp
Sheets("Display").Select
Range("A1").Select
End Sub
Any help would be greatly appreciated - thank you!