Macro DoubleClick problem

[ed.ayers315]

Hi Folks

I tried to put together a couple of double click events the forum users "wigi" and "p45cal" provided with a couple self modification to get what I needed.

Now the problem is alone they work great but not on the same worksheet.

I would like to be able to use both on the same sheet. Any advise would be great!


Here is the code:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, _
Cancel As Boolean)
Dim str As String
Dim cboTemp As OLEObject
Dim ws As Worksheet
Set ws = ActiveSheet
Cancel = True
Set cboTemp = ws.OLEObjects("TempCombo")
On Error Resume Next
With cboTemp
'clear and hide the combo box
.ListFillRange = ""
.LinkedCell = ""
.Visible = False
End With
On Error GoTo errHandler
If Target.Validation.Type = 3 Then
'if the cell contains a data validation list
Application.EnableEvents = False
'get the data validation formula
str = Target.Validation.Formula1
str = Right(str, Len(str) - 1)
With cboTemp
'show the combobox with the list
.Visible = True
.Left = Target.Left + 1
.Top = Target.Top + 1
.Width = Target.Width + 14
.Height = Target.Height
.ListFillRange = ws.Range(str).Address
.LinkedCell = Target.Address
End With
cboTemp.Activate
End If

errHandler:
Application.EnableEvents = True
Exit Sub
<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o> </o>
End Sub
'=========================================
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim str As String
Dim cboTemp As OLEObject
Dim ws As Worksheet
Set ws = ActiveSheet
<o> </o>
Set cboTemp = ws.OLEObjects("TempCombo")
On Error Resume Next
If cboTemp.Visible = True Then
With cboTemp
.Top = 10
.Left = 10
.ListFillRange = ""
.LinkedCell = ""
.Visible = False
.Value = ""
End With
End If
<o> </o>
errHandler:
Application.EnableEvents = True
ActiveSheet.Shapes("TempCombo").Visible = True
<o> </o>
ActiveSheet.Calculate
ActiveWindow.SmallScroll
Application.WindowState = Application.WindowState
<o> </o>
Exit Sub
<o> </o>
End Sub
<o> </o>
<o> </o>

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("g21:h21,g23:h23,g25:h25,g27:h27,g29:h29,g31:h31,g33:h33,g35:h35,g37:h37,g39:h39,g41:h41,g43:h43,g48:h48,g50:h50,g52:h52,g54:h54,g56:h56,g58:h58,g60:h60,g62:h62,g64:h64,g66:h66")) Is Nothing Then
Cancel = True
If VarType(Target.Value) = vbBoolean Then
Target.Value = Not (Target.Value)
Else
Target.Value = IIf(Target.Value = 1, Null, 1)
End If
End If
End Sub

 

[p45cal]

Please confirm:
1. It's the two doubleclick events you want to merge.
2. We can ignore completely the SelectionChange event.
3. The cells for the true/false or 0/1 treatment are mutually exclusive to the cells with Data Validation that you wantto process.

 

[ed.ayers315]

Yes, I would like to merge the two so both can run at the same time on the same sheet.

Thank you for the response.

 

[p45cal]

Yes, I would like to merge the two so both can run at the same time on the same sheet.

Thank you for the response.

Could you address ALL the questions asked in msg#2 please.

 

[ed.ayers315]

Sorry,

1) Yes, if we could merge, that would be great.

2) Yes, we can ignor the selectchange

3) Yes, the data validation cells are different from the True/False cells.

Thanks

 

[p45cal]

I'm not sure just what you want to happen when a user double-clicks neither type of cell so this is just an untested guess:

Private Sub ccWorksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim HasValidation As Boolean
On Error Resume Next
HasValidation3 = Target.Validation.Type = 3
On Error GoTo 0
Dim str As String
Dim cboTemp As OLEObject
Cancel = True
Set cboTemp = Me.OLEObjects("TempCombo")
On Error Resume Next
With cboTemp
  'clear and hide the combo box
  .ListFillRange = ""
  .LinkedCell = ""
  .Visible = False
End With
On Error GoTo errHandler
If HasValidation3 Then
  'if the cell contains a data validation list
  Application.EnableEvents = False
  'get the data validation formula
  str = Target.Validation.Formula1
  str = Right(str, Len(str) - 1)
  With cboTemp
    'show the combobox with the list
    .Visible = True
    .Left = Target.Left + 1
    .Top = Target.Top + 1
    .Width = Target.Width + 14
    .Height = Target.Height
    .ListFillRange = Range(str).Address
    .LinkedCell = Target.Address
  End With
  cboTemp.Activate
Else
  If Not Intersect(Target, Range("g21:h21,g23:h23,g25:h25,g27:h27,g29:h29,g31:h31,g33:h33,g35:h35,g37:h37,g39:h39,g41:h41,g43:h43,g48:h48,g50:h50,g52:h52, g54:h54,g56:h56,g58:h58,g60:h60,g62:h62,g64:h64,g66:h66")) Is Nothing Then
    Cancel = True
    If VarType(Target.Value) = vbBoolean Then
      Target.Value = Not (Target.Value)
    Else
      Target.Value = IIf(Target.Value = 1, Null, 1)
    End If
  End If
End If

errHandler:
Application.EnableEvents = True
End Sub

 

[ed.ayers315]

Thanks,

I place it in tonight and give it a roll.

 

[ed.ayers315]

Hello p45cal,

I loaded that but it did not work and stopped the True/False from working.

Below is a few lines from my sheet.

Any help would be great, even if something does not work, I learn. Good deal in my book.


<!-- ######### Start Created Html Code To Copy ########## -->

Excel Workbook
	B	C	D	E	F	G	H	I
19	Summary of Sections: "New Issues to Address", "New or Current Service Call Results", "Cost Review Results", "PAMP Goal Updates", & "Audit Results"
20	Observation/s /Comment/s				Suggested Follow-up ActionsVendor and/or Customer
21					Vendor			Customer
22
23					Vendor			Customer
24
25					Vendor			Customer
26
SERVICE_REPORT

<!-- ######### End Created Html Code To Copy ########## -->

 

[p45cal]

I forgot to remove the cc from

Private Sub ccWorksheet_BeforeDoubleClick</pre>

 

[ed.ayers315]

Thank you

That is what I call High Powered Help