Double click to bring up userform

[rgr]

Hi,

I'm trying to bring up a userform with a double click in a range. The code below works but the focus stays in the cell in edit mode. Is there any way to set the focus on the userform with the cursor blinking inside the textbox? Also, I set the userform to be modeless, but it disappears everytime it is used. Is there any way to prevent this? I appreciate any help you might be able to give me.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Set player1 = Range("B5:B36")
Set player2 = Range("D5:D36")
Set player3 = Range("H5:H36")
Set player4 = Range("J5:J36")
For Each Target In Selection
    If Application.Intersect(Selection, player1) Is Nothing And _
    Application.Intersect(Selection, player2) Is Nothing And _
    Application.Intersect(Selection, player3) Is Nothing And _
    Application.Intersect(Selection, player4) Is Nothing Then
        MsgBox "Select Partnership Cell"
    Else
        UserForm1.Show
        UserForm1.???
   End If
Next
End Sub

[johnske]

Hi,

I'm trying to bring up a userform with a double click in a range. The code below works but the focus stays in the cell in edit mode. Is there any way to set the focus on the userform with the cursor blinking inside the textbox? Also, I set the userform to be modeless, but it disappears everytime it is used. Is there any way to prevent this? I appreciate any help you might be able to give me.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Set player1 = Range("B5:B36")
Set player2 = Range("D5:D36")
Set player3 = Range("H5:H36")
Set player4 = Range("J5:J36")
For Each Target In Selection
    If Application.Intersect(Selection, player1) Is Nothing And Application.Intersect(Selection, player2) Is Nothing _
    And Application.Intersect(Selection, player3) Is Nothing And Application.Intersect(Selection, player4) Is Nothing Then
        MsgBox "Select Partnership Cell"
    Else
        UserForm1.Show
        UserForm1.???
    End If
Next
End Sub

Basically, here's what you need to do

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'to show modeless
UserForm1.Show False
'to get out of 'edit' mode
Application.EditDirectlyInCell = False
'set focus in text box
UserForm1.TextBox1.SetFocus
End Sub

So, for your code, this gives

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Set player1 = Range("B5:B36")
Set player2 = Range("D5:D36")
Set player3 = Range("H5:H36")
Set player4 = Range("J5:J36")
For Each Target In Selection
    If Application.Intersect(Selection, player1) Is Nothing And Application.Intersect(Selection, player2) Is Nothing _
    And Application.Intersect(Selection, player3) Is Nothing And Application.Intersect(Selection, player4) Is Nothing Then
        MsgBox "Select Partnership Cell"
    Else
        UserForm1.Show False
        Application.EditDirectlyInCell = False
        UserForm1.TextBox1.SetFocus
    End If
Next
End Sub

[rgr]

That works very well, thank you Johnske, and Happy New Year

[johnske]

Not a prob, and a Happy New Year to you also