Excel VBA: Run-time error (Method 'Value' of object 'Range' failed), but only on consecutive runs

Question

I'm having an issue with a VBA project I'm working on at the moment, specifically a run-time error with a piece of code that finds the next empty cell at the bottom of the table and writes stored strings to that range

Now - a quick explanation of the project. I've a table in an Excel sheet that records each prospective job that the company I work for may have coming-up. To that I have a front-end that has controls for creating/reviewing new "Jobs" or "Opportunities", and the code that runs here does some sense-checking of the info, creates a standardized folder structure on the network drive for Contact and Contract info, and generates a unique ID for the job that will then be used for our CRM and communications

The code I have seems to run without issue the first time (ADD NEW JOB) -> (CREATE), but crash on a second run and it'll throw the run-time error '-2147417848(80010108)': Method 'Value' of object 'Range' failed. at the line:

r.Value = pFix

and Excel (2016 on Windows 10) will crash and restart

Edit: I believe this to be perhaps because r isn't being stored correctly on the second run - or perhaps isn't being cleared from memory correctly after the first. However I've tried Set r = Nothing and what I've read here indicates this shouldn't be an issue anyway

This code is taken from the Button_Click event on UserForm frmNewJob (the entry form shown in the screen grab)

Private Sub CommandButton1_Click()
    Dim pFix As String
    Dim sNew As Long
    Dim jNumber As String
    Dim jName As String
    Dim jIndex As String
    Dim jClient As String
    Dim jSite As String
    Dim jComments As String
    Dim cName As String
    Dim createdDate As Date
    Dim r As Range
    Dim hLink As String
    Dim hLink2 As String
    Dim wDir As String
    Dim msg As String
    Dim ans As String

    Set r = Nothing


    wDir = ActiveWorkbook.Path

    If TextBox1.Value = "" Then
        Call MsgBox("Please enter a valid Requester Name", vbCritical)
        Exit Sub
    Else

        If TextBox2.Value = "" Then
            Call MsgBox("Please enter a valid Client Name", vbCritical)
            Exit Sub
        Else

            If TextBox3.Value = "" Then
                Call MsgBox("Please enter a valid Site Description", vbCritical)
                Exit Sub
            Else

            End If
        End If
    End If

    pFix = "GSM"
    sNew = WorksheetFunction.Max(Columns(2)) + 1
    jNumber = pFix & sNew
    jClient = TextBox2.Value
    jIndex = Left(jClient, 1)
    jSite = TextBox3.Value
    jName = jClient & " - " & jSite
    jComments = TextBox4.Value
    cName = TextBox1.Value
    createdDate = Now


    Set r = Sheet1.Range("A" & Rows.Count).End(xlUp).Offset(1)

    r.Value = pFix
    r.Offset(0, 1) = sNew
    r.Offset(0, 2) = jNumber
    r.Offset(0, 3) = jName
    r.Offset(0, 4) = jComments
    r.Offset(0, 5) = createdDate
    r.Offset(0, 6) = cName

    Call MsgBox("New Job Number is: " & jNumber, vbOKOnly)

    On Error Resume Next
    hLink = wDir & "\" & jIndex
    MkDir hLink

    hLink = hLink & "\" & jNumber & " - " & jName
    MkDir hLink

    hLink2 = hLink & "\" & "1. Tender Documents"
    MkDir hLink2

    hLink2 = hLink & "\" & "2. Clarifications and Addendums"
    MkDir hLink2

    hLink2 = hLink & "\" & "3. Client Correspondence and MoU's"
    MkDir hLink2

    hLink2 = hLink & "\" & "4. Technical Queries"
    MkDir hLink2

    hLink2 = hLink & "\" & "5. Document Register"
    MkDir hLink2

    hLink2 = hLink & "\" & "6. Subcontractor and Material Pricing"
    MkDir hLink2

    hLink2 = hLink & "\" & "7. Estimate"
    MkDir hLink2

    hLink2 = hLink & "\" & "8. Photos"
    MkDir hLink2

    hLink2 = hLink & "\" & "9. Tender Submission"
    MkDir hLink2

    hLink2 = hLink & "\" & "10. Drawings"
    MkDir hLink2

    hLink2 = hLink & "\" & "11. Post Tender Correspondence"
    MkDir hLink2



    Unload Me

    'Call filterByJobNumber
    Call copyTable

    msg = "Would you like to open the newly created directory?"
    ans = MsgBox(msg, vbYesNo, "Open Directory?")

    If ans = vbYes Then
        Shell "explorer """ & hLink & "", vbNormalFocus
    Else
    End If


End Sub

The fact that it's crashing Excel rather than just breaking and letting me debug is what's throwing me - and the fact that without fail it will run the first time but crash on the second

Edit: I've narrowed it down to the line r.Value = pFix which is the point where the stored pFix string is written into a new range r. Popping in a msgbox(pFix) before this line shows that the correct pFix string is stored, so the error must be with the range

Maybe some fresh eyes will uncover a mistake I'm overlooking - and learning the cause will prevent a repeat later

Edit 2:

I've done some further testing and the issue is definitely occurring on the second instance of the code running, when writing a value to range r. I've created a little test to force the crash, on the below code Excel will lock-up and quit on the second Loop - it only appears to happen when the Address of rchanges (row count increases) between each consecutive run, and the new line created is at the bottom of a Table (Excel is automatically adding this new line to the Table range). Can someone run the code and confirm if they have the same issue?

Sub testMacro()

    Dim r As Range
    Dim str As String

    str = "TEST"
    i = 1

    Do Until i = 5
        Set r = Sheet1.Range("A" & Rows.Count).End(xlUp).Offset(1)
        Call MsgBox(r.Address, vbOKOnly, "Range address for 'r' is")
        r = str
        i = i + 1
    Loop


End Sub

I've attempted to Uninstall/Reinstall and Repair the Office 2016 installation as an additional measure but it hasn't helped. Perhaps a Windows 10 quirk if it's not repeatable elsewhere?

Answer 1

Based on what I noticed, this error only occurrs in Excel Tables in Excel 2013, 2016 and higher versions.

Actually, This problem is: after the first row, it is unable to add another row automatically to the table.

The strange thing is that, out of 10 Tables in a workbook, only 1 table might encounter this error. Making it difficult to understand the nature of the error.

Hence, in order to solve the problem, convert your table(s) to range(s); use NAME MANAGER to create dynamic range(s) that can adjust automatically according to the size of your data.

I hope this was helpful.

Answer 2

Answered as 'Community Wiki' to remove from the unanswered questions list and as I've resolved without altering the code.

It appears there was some underlying issue with the Office 2016/Excel 2016 installation. I did manage to generate a VBA "Out of Memory" error in further testing, but changes to the code appear not to have had any positive affect in this particular case.

Removing, Rebooting and Reinstalling Office again (for a 2nd time) appears to have fixed the issue without any additional changes to the Workbook, and the original Sub runs without creating errors