Code works on my computer but not any other

[AnotherExcelGuy]

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'

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!

 

[mole999]

and are you sure it is table 14 and not something that has been recreated with a different number ?

 

[AnotherExcelGuy]

Yeah - I check that table14 still had the same name.

 

[Steve_]

I ran into this EXACT same problem about 6 or 7 years ago. It was caused by an unexpected 32 BIT windows device in my network environment that had escaped my notice.

The issue had to do with the versioning of Office and VBA...The 64 bit version of Office was VBA7 while the 32 bit version was either 6 or 6.5.

I had to use...




#If VBA7 Then Declare PtrSafe Sub... #Else Declare Sub... #EndIf



I feel like you may need to use something similar.

 

[AnotherExcelGuy]

I ran into this EXACT same problem about 6 or 7 years ago. It was caused by an unexpected 32 BIT windows device in my network environment that had escaped my notice.

The issue had to do with the versioning of Office and VBA...The 64 bit version of Office was VBA7 while the 32 bit version was either 6 or 6.5.

I had to use...




#If VBA7 Then Declare PtrSafe Sub... #Else DeclareSub... #EndIf



I feel like you may need to use something similar.

This is exciting, maybe some light at the end of the tunnel. Could you or anyone else please advice how exactly I could implement that code?
Thank you!

 

[AnotherExcelGuy]

It looks like this is what you are reffering to: https://docs.microsoft.com/en-us/of...ween-the-32-bit-and-64-bit-versions-of-office

However, implementing this is a little beyond my scope, I'm not sure I undertand this.

 

[Steve_]

It looks like this is what you are reffering to: https://docs.microsoft.com/en-us/of...ween-the-32-bit-and-64-bit-versions-of-office

However, implementing this is a little beyond my scope, I'm not sure I undertand this.

So, line 41 of your code is throwing an error due to the syntax of what you are doing having changed from 32 bit to 64 bit..


Line 41 is currently...
Set lNewRow = ThisWorkbook.Sheets("Data Entry").ListObjects("Table14").ListRows.Add


REM that line out.


And beneath it...Paste this code in its place.

#If  VBA7 Then ' Check if is 64 bit..
    'Run 64 bit version of your desired command...in this case:
    Set lNewRow = ThisWorkbook.Sheets("Data Entry").ListObjects("Table14").ListRows.Add
#Else 
    'Run 32 bit version of your desired command from above. You may have to do a bit of research for this.
#End  If

And for a little bit more light for that tunnel..This was the EXACT type of code I was having the versioning issue with. I had to find the 32 bit version of code to add rows to my table. I cannot remember what the difference was but it wasnt hard to figure out.

 

[blbat]

Do either of you have multiple workbooks open at the same time?

if you do, try changing this line of code

 UnFreezeApp
    ActiveWorkbook.RefreshAll

to

UnFreezeApp
ThisWorkbook.RefreshAll

there is a difference between "ThisWorkbook" and "ActiveWorkbook"

 

[AnotherExcelGuy]

Would I be able to apply the ptr declaration code to the entire script?

This is what was on the microsoft website:

#if  VBA7 then
   Declare PtrSafe Sub MessageBeep Lib "User32" (ByVal N AS Long)
#else 
   Declare Sub MessageBeep Lib "User32" (ByVal N AS Long)
#end  if

I've tried to add different variations of this but keep having issues with the declare part.