bob
bob

Reputation: 3

Excel menu bar freeze after running code. unfreeze after right mouse click

I'm using a form with a button to download a sheet from intranet and populate this destination sheet with data from the source sheet. This part works: the data is populated, form unloads, script stops and I've got my destination sheet as active screen.
Now comes the problem: I can select cells, but can't use any functions in Excel, can't push any buttons like File, Home or Save on the quick access ribbon. Pushing ESC doesn't help. The only thing that unfreezes Excel is pushing right mouse button somewhere in a random cell. It 'unlocks' excel and I can go the File menu. I don't know where to look. I think it's something small but can't figure out what is it.

This is the code (the jump is used for single or multi items. If it's for 1 item I skip the loop. Maybe there is a better option for this?):

Private Sub genbutton_Click()
    On Error GoTo 0

    Dim startsheet As String
    startsheet = ActiveSheet.Name
    roww = ActiveCell.Row

    Set Source = ActiveWorkbook.ActiveSheet

    'search for column in source sheet
    kolommaint = kolomnaam2("Maintenance Plan")
    kolomfloc = kolomnaam2("Functional Location")
    kolomdescrip = kolomnaam2("Maintenance item description")
    kolomequip = kolomnaam2("Equipment")

    'find last row on data source page
    With ActiveSheet
        lastrow = .Cells(.Rows.Count, kolommaint).End(xlUp).Row
    End With

    Set destinationsheet = Workbooks.Open("http:// sheet on intranet.xlsm")

    'find first data row on destination sheet
    Dim FindString As String
    Dim Rng As Range
    FindString = "Action"
    With destinationsheet.Sheets("Data input").Range("A:A")
        Set Rng = .Find(What:=FindString, _
                    After:=.Cells(.Cells.Count), _
                    LookIn:=xlValues, _
                    LookAt:=xlWhole, _
                    SearchOrder:=xlByRows, _
                    SearchDirection:=xlNext, _
                    MatchCase:=False)
        If Not Rng Is Nothing Then
            Application.Goto Rng, True
            datarij = ActiveCell.Row + 1
        End If
    End With
    'make a jump to avoid loop if only 1 item is needed
    If callsingle.Value = True Then
        i = roww

        If Source.Range(kolommaint & i).Value = "" Then
            GoTo verdergaan
        End If
        GoTo jump
    End If

    For i = eerstedatarij To lastrow

jump:
        'skip row if empty
        If Source.Rows(i).Hidden = True Then
            GoTo verdergaan
        End If

        destinationsheet.Sheets("Data input").Range("A" & datarij).Value = "Release Call"
        destinationsheet.Sheets("Data input").Range("B" & datarij).Value = Source.Range(kolommaint & i).Value
        destinationsheet.Sheets("Data input").Range("C" & datarij).Value = "PM"
        destinationsheet.Sheets("Data input").Range("E" & datarij).Value = Source.Range(kolomdescrip & i).Value
        destinationsheet.Sheets("Data input").Range("F" & datarij).Value = Source.Range(kolomdescrip & i).Value
        destinationsheet.Sheets("Data input").Range("G" & datarij).Value = Source.Range(kolomfloc & i).Value
        destinationsheet.Sheets("Data input").Range("H" & datarij).Value = Source.Range(kolomequip & i).Value

        datarij = datarij + 1

        'make jump if single item is used
        If callsingle.Value = True Then
            GoTo jump2
        End If

verdergaan:
    Next i
jump2:

    destinationsheet.Sheets("Data input").Range("A13").Select

    Set Source = Nothing
    Set destinationsheet= Nothing

    Unload Me

End Sub

I'm using the code below to unfreeze excel for now:

Private Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)
 Const MOUSEEVENTF_RIGHTDOWN = &H8
 Const MOUSEEVENTF_RIGHTUP = &H10

 Public Sub RightDown()
     mouse_event MOUSEEVENTF_RIGHTDOWN, 0, 0, 0, 0
     mouse_event MOUSEEVENTF_RIGHTUP, 0, 0, 0, 0
 End Sub

Upvotes: 0

Views: 690

Answers (1)

Fredrik F
Fredrik F

Reputation: 1

I got a similar problem with freeze on Excel functions. I believe that it's caused by a focus bug when opening worksheet with "Worksheets.Open"

The problem appeared when having a userform visible when executing "Worksheets.Open". I had to hide the userform first and then open the worksheet to avoid the freeze problem.

The code that causes the freeze on excel functions:

Private Sub btnBrowse_Click()
  Dim retVal As Integer
  Dim fDialog As FileDialog
  Set fDialog = Application.FileDialog(msoFileDialogFilePicker)

  fDialog.AllowMultiSelect = False
  retVal = fDialog.Show()

  If retVal = -1 Then
    Application.Workbooks.Open fDialog.SelectedItems(1)
    Me.Hide   ' Hiding my userform
  End If
End Sub

But I found a solution to the freeze with hide and show the worksheet window.

  Dim aWorkbook As Workbook
  Set aWorkbook = ActiveWorkbook
  aWorkbook.Windows(1).Visible = False
  aWorkbook.Windows(1).Visible = True

Then it worked. The only downside is that changing the visibility puts the worksheet in a changed state. If it is possible it would be better just to hide the userform before opening the workbook.

Upvotes: 0

Related Questions