Double click event query

[Ironman]

Hi

The below code was kindly provided to me by somebody on the board many years ago and the layout of the relevant sheet has changed since then.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Column = 7 Then
TopCell = Cells(12, 3).Address
BottomCell = Cells(ActiveCell.Row, 3).Address

TotalCalc = Application.WorksheetFunction.Sum(Range(TopCell, BottomCell))

MsgBox "Total miles run to " & Format(Cells(ActiveCell.Row, 1), "dd mmmm yyyy: ") & _
Format((CLng(10720.31 + TotalCalc)), "#,##0") & "   ", vbOKOnly, "Lifetime Mileage"
End If

If Not Application.Intersect(Range("A8:C9"), Range(Target.Address)) Is Nothing Then
End If

End Sub

Following changes to the worksheet some years ago I believe the below line is causing the workbook to hang because the range is now meaningless.

If Not Application.Intersect(Range("A8:C9"), Range(Target.Address)) Is Nothing Then
End If

The objective of the code is on double clicking any cell in Column G from row 12 to say row 20000 (I'm down to row 6800 at the moment) and NO OTHER CELLS then a msgbox with a cumulative value in it is produced. This runs OK but Excel frequently hangs if I happen to double click cells in other columns and I'm hoping it's because of the above range being incorrect.

I'd be grateful for some help to amend the range and hopefully eliminate the hanging issue.

Many thanks.

 

[Norie]

You don't have this anywhere in the code.

Cancel = True

That's needed to cancel the default action of double clicking a cell which is to edit the cell that's been double clicked.

When it edit mode no code will run so that could be why it appears the code is hanging.

You should put the above code after the code that checks if cell that has been double clicked is in the range of interest.

In this case that's being done by your first If statement, so try this.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

    ' check Target is in column G
    If Target.Column = 7 Then
        Cancel = True
        TopCell = Cells(12, 3).Address
        BottomCell = Cells(Target.Row, 3).Address

        TotalCalc = Application.WorksheetFunction.Sum(Range(TopCell, BottomCell))

        MsgBox "Total miles run to " & Format(Cells(ActiveCell.Row, 1), "dd mmmm yyyy: ") & _
                     Format((CLng(10720.31 + TotalCalc)), "#,##0") & "   ", vbOKOnly, "Lifetime Mileage"
    End If

End Sub

 

[Ironman]

Hey that works perfectly Norie, I'll keep my fingers crossed but so far no more hanging - thanks ever so much!

 

[Ironman]

Hi again Norie

Unfortunately the temporary hanging after double clicking is still occurring, but not all the time!

I've noted that although the above code still runs fine with your amendment, it also runs when I double click cells G1:G10. I understood it should only run for cells G11 onwards?

The Double Click event also runs the below code:

If Target.Address(0, 0) <> "A11" Then Exit Sub
Cells(Rows.Count, 1).End(xlUp).Offset(0, 0).Select

End Sub

The above 2 lines create a link from cell A11 to the first empty row in Column A. Could there be something missing from this code that could be causing the hangs when I double click any cell outside either Column G (re first macro) and Column A (the above code)?

Many thanks again.

 

[Norie]

The code I posted will run when any cell in column G is double clicked.

I know you mentioned that you wanted to restrict it to only certain rows but I wasn't sure which rows they were so didn't include that in the code.

If you can explain which rows in G the code should work for I can post amended code to include that.

As for running this code:

If Target.Address(0, 0) <> "A11" Then Exit Sub
Cells(Rows.Count, 1).End(xlUp).Offset(0, 0).Select

End Sub

Where is that code located?

 

[Ironman]

Hi Norie

The relevant rows in Column G are G12 onwards (say to 20000)

The complete code for the double click event is as follows:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

    ' check Target is in column G
    If Target.Column = 7 Then
        Cancel = True
        TopCell = Cells(12, 3).Address
        BottomCell = Cells(Target.Row, 3).Address

        TotalCalc = Application.WorksheetFunction.Sum(Range(TopCell, BottomCell))

        MsgBox "Total miles run to " & Format(Cells(ActiveCell.Row, 1), "dd mmmm yyyy: ") & _
                     Format((CLng(10720.31 + TotalCalc)), "#,##0") & "   ", vbOKOnly, "Lifetime Mileage"
    End If

'The following 2 lines create a 'hyperlink' from Cell A11 to first empty row

If Target.Address(0, 0) <> "A11" Then Exit Sub
Cells(Rows.Count, 1).End(xlUp).Offset(0, 0).Select

End Sub

I hadn't included the second macro because I didn't think there was anything wrong with that, but you know better than I do on how to write code.

Many thanks again!

 

[Norie]

This code will ensure the code is only executed when column G is double clicked from row 12 down.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

    ' check Target is in column G and is in row 12 or below
    If Target.Column = 7 And Target.Row>=12 Then
        Cancel = True
        TopCell = Cells(12, 3).Address
        BottomCell = Cells(Target.Row, 3).Address

        TotalCalc = Application.WorksheetFunction.Sum(Range(TopCell, BottomCell))

        MsgBox "Total miles run to " & Format(Cells(ActiveCell.Row, 1), "dd mmmm yyyy: ") & _
                     Format((CLng(10720.31 + TotalCalc)), "#,##0") & "   ", vbOKOnly, "Lifetime Mileage"
    End If

End Sub

When do you want this code to run?

If Target.Address(0, 0) <> "A11" Then Exit Sub
Cells(Rows.Count, 1).End(xlUp).Offset(0, 0).Select

Is it only when A11 is double-clicked?

 

[Ironman]

Yes, only when A11 is double-clicked.