Problem Inserting Value Into Cell

Below is code that completely works... with the exception of line highligeted in Red. I get a run-time error 1004. I've tried every thing with my very limited VBA knowlege. Help!
Steve

Private Sub Workbook_Activate()
'Stop
    Dim chkBox As Excel.CheckBox
    'Finds Windows UserProfile
    Worksheets(1).Range("H56").Value = Environ("userprofile")
    Application.ScreenUpdating = False
    'Clears Req'd Cells
    If ThisWorkbook.Name = "BSB Elevate Quote v4.xlsm" Then
        'Clear Contact Info Tab
        Sheets("Contact Info").Activate
        With Sheets("contact info")
        .Range("C6:C8,C10:C13,C15:C17,C24,C55").ClearContents
        'Inserts Formula for Rep Name
        .Range("C20").Formula = "=D109"
        'Inserts 1 for Site Qty
        .Range("C7").Select
        'Clear Elevate Pricing Tab
        Sheets("elevate pricing").Activate
        End With
        With Sheets("elevate pricing")
        .Range("W4").Value = 1
        .Range("D7:D163,J7:J163,O7:O163").ClearContents
        'Clear Labor Changes (Col V)
        Range("v174").Copy
        Range("V84:V91,V93:V118,V120:V135,V137:V138,V140:V159,V161:V163").PasteSpecial xlPasteFormulas
        Application.CutCopyMode = False
        'Clear Check Box 1
        ActiveSheet.CheckBoxes("Check Box 1").Value = xlOff
        .Range("B7").Select
        'Clear Keysheet Tab
        Sheets("keysheet").Activate
        End With
        With Sheets("keysheet")
        .Range("C7:R252").ClearContents
        .Range("B6").Select
        'Clear Notes Tab
        Sheets("notes").Activate
        End With
        With Sheets("Notes")
        .Range("C6:C55").ClearContents
        .Range("B5").Select
        'Activate Contact Info Tab
        Sheets("Contact Info").Activate
        '.Range("C7").Select
        End With
    End If
    Application.ScreenUpdating = True
    'Application.DisplayAlerts = False
End Sub