Application Inputbox not showing selected cells

[jeremyjohnolson]

Everything is working fine in the below code, except when the application input box for some reason will not show the marching ants around the cells I select. The code still functions properly and it does select the cells I click on with my mouse, but from a user's point of reference it seems almost like it is not because it will not put those marching ants around the selection. If if put application.input box in another workbook it works fine and shows the ants, but for some reason in this one it won't. Any clues why???

Option Explicit

Sub EmailConvos(control As IRibbonControl)
   
   Application.ScreenUpdating = False
    
    'Add Tools->References->"Microsoft Outlook nn.n Object Library"
    'nn.n varies as per our Outlook Installation
    Dim WksName As String
    WksName = "Macro" '****name of worksheet to put data****


    Dim DestCell As Range
    Dim appOutlook As Object 'Outlook.Application
    Dim nms As Object 'Outlook.Namespace
    Dim Folder As Object 'Outlook.MAPIFolder
    Dim EndDate As Date
    Dim BegDate As Date
    Dim iTims As Object 'Outlook.Items
    Dim iRow As Integer
    Dim oRow As Integer
    Dim nEmails As Integer
    Dim nConvos As Integer
    
    On Error Resume Next
    Set DestCell = Application.InputBox(Prompt:="Please use mouse to select destination cell.", _
        Title:="Destination Cell", Default:=ActiveCell.Address, Type:=8)
    On Error GoTo 0
    If DestCell Is Nothing Then
        Exit Sub
    Else
        Set appOutlook = GetObject(, "Outlook.Application")
        Set nms = appOutlook.GetNamespace("MAPI")
        Set Folder = nms.PickFolder
        EndDate = ActiveSheet.Range("EndDate").Value + 1
        BegDate = EndDate - 6
        Set iTims = Folder.Items.Restrict("[SentOn] > '" & BegDate & "' And [SentOn]<'" & EndDate & "'")
            
        'Make screen go back to showing Excel after picking Outlook folder
        AppActivate ActiveWorkbook.Name
    
        'Handle potential errors with Select Folder dialog box.
        If Folder Is Nothing Then
            MsgBox "There are no mail messages to export", vbOKOnly, "Error"
            GoTo JumpExit
        ElseIf Folder.DefaultItemType <> 0 Then
            MsgBox "These are not Mail Items", vbOKOnly, "Error"
            GoTo JumpExit
        ElseIf Folder.Items.Count = 0 Then
            MsgBox "There are no mail messages to export", vbOKOnly, "Error"
            GoTo JumpExit
        End If
    
        'Read Through each Mail and export the details to Excel for Email Archival
        Folder.Items.Sort "Received"
        
        'Clear old data
        Worksheets(WksName).Cells(1, 1).EntireColumn.Clear
        Worksheets(WksName).Cells(1, 2).EntireColumn.Clear
        
        'Insert Column Headers
        Worksheets(WksName).Cells(1, 1) = "Conversation Topics:"
        Worksheets(WksName).Cells(1, 2) = "Sent Date:"
        
        'Insert Mail Data
        For iRow = 1 To iTims.Count
            oRow = iRow + 1
            Worksheets(WksName).Cells(oRow, 2) = iTims.Item(iRow).SentOn
            Worksheets(WksName).Cells(oRow, 1) = iTims.Item(iRow).ConversationTopic
        Next iRow
        
        'Put EndDate and BegDate on sheet
        Worksheets(WksName).Cells(5, 4).Value = BegDate
        Worksheets(WksName).Cells(5, 5).Value = EndDate
        
        'put number of emails on sheet
        nEmails = Worksheets(WksName).Cells(1, 1).EntireColumn.Cells.SpecialCells(xlCellTypeConstants).Count - 1
        Worksheets(WksName).Cells(2, 4).Value = nEmails
        
        'Remove duplicates
        Worksheets(WksName).Range("A:B").RemoveDuplicates Columns:=1, Header:=xlYes
        
        'put number of conversations on sheet
        nConvos = Worksheets(WksName).Cells(1, 1).EntireColumn.Cells.SpecialCells(xlCellTypeConstants).Count - 1
        Worksheets(WksName).Cells(2, 5).Value = nConvos
        DestCell.Value = nConvos
        
        'Formatting & hide tab
        Worksheets(WksName).Cells(1, 1).Font.Underline = xlUnderlineStyleSingle
        Worksheets(WksName).Cells(1, 2).Font.Underline = xlUnderlineStyleSingle
        Worksheets(WksName).Range("A:E").EntireColumn.AutoFit
'        Worksheets(WksName).Visible = True
        Worksheets(WksName).Visible = xlSheetVeryHidden
        Application.ScreenUpdating = True
    End If
 
JumpExit:
    Set nms = Nothing
    Set Folder = Nothing
    Application.ScreenUpdating = True
    Exit Sub


End Sub

 

[jeremyjohnolson]

Haha, just figured out the answer to my own question...screen updating = false was making the screen not update...duh!