Double click cell to relocate active cell

[Ironman]

Hi

Each cell in an expanding named range "AnalysisRoutesList" in Col E has data validation, so when a cell is double clicked, an Information msgbox appears (OK, Cancel, Help) prompting me to double click the cell 3 columns to the left of the one I have just double clicked (Col B).

What I'd be grateful for is some code so when I double click any cell in the above named range (it expands by inserting rows within the range, not at the bottom), the cell in the same row in Col B is selected (or better still, double clicked).

(Double clicking a cell in Col B runs a search macro, but it fails to locate the correct cell fairly frequently, hence why I don't simply double click the cell in Col B - but I need to do it this way because the code associated with double clicking the cell in Col B runs perfectly every time when I double click AnalysisRoutesList cells first, then go back to Col B).

Many thanks!

 

[Siddharth Rout]

Is this what you are trying (UNTESTED)?

Replace NameOfTheMacroToBeRun in the code below with the name of the macro which will run when the cell in B is double clicked.

Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    On Error GoTo Whoa
    
    Application.EnableEvents = False
    
    If Not Intersect(Target, Range("AnalysisRoutesList")) Is Nothing Then
        Target.Offset(, -2).Activate
        Cancel = True
        
        '~~> Change this to the name of the macro to be run
        '~~> When the cell in B is double clicked
        NameOfTheMacroToBeRun
    End If
        
Letscontinue:
    Application.EnableEvents = True
    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume Letscontinue
End Sub

 

[Ironman]

Hi Sid, thanks for taking the time to reply!

The existing macro isn't in a separate module, but another double click event (activated in Col B) in the same sheet, so I'm afraid I can't insert a name:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim foundRange As Range
    Dim searchStr As String
   
    If Not Intersect(Target, Range("B:B")) Is Nothing Then
        searchStr = Replace(Target.Value, ".", "")
        Set foundRange = findRange(ActiveSheet.UsedRange, searchStr)
        If Not foundRange Is Nothing Then
            foundRange.Select
        Else
           'MsgBox searchStr & " not a valid route - route search function only", vbInformation, "Route Locator"
            MsgBox "Invalid search - double click ROUTE # cell only", vbCritical, "Invalid Cell Selection"
        End If
        Cancel = True
    End If
End Sub

Function findRange(searchRange As Range, findWhat As String) As Range
    Dim LastCell As Range
   
    With searchRange
        Set LastCell = .Cells(.Cells.Count)
    End With
    Set findRange = searchRange.Find(what:=findWhat, after:=LastCell)
End Function

 

[Siddharth Rout]

In that case simply combine all of them. Some thing like this (UNTESTED). There is no need to select cell in Col B after all. Directly work with it.

Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    On Error GoTo Whoa
   
    Application.EnableEvents = False
   
    Dim searchStr As String
    Dim rng As Range
    Dim foundRange As Range
   
    If Not Intersect(Target, Range("AnalysisRoutesList")) Is Nothing Then
        '~~> This is your range in Col B
        Set rng = Target.Offset(, -2)
       
        '~~> Work with that range
        searchStr = Replace(rng.Value, ".", "")
        Set foundRange = findRange(ActiveSheet.UsedRange, searchStr)
       
        If Not foundRange Is Nothing Then
            foundRange.Select
        Else
            MsgBox "Invalid search - double click ROUTE # cell only", vbCritical, "Invalid Cell Selection"
        End If
       
        Cancel = True
    End If
       
Letscontinue:
    Application.EnableEvents = True
    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume Letscontinue
End Sub

Function findRange(searchRange As Range, findWhat As String) As Range
    Dim LastCell As Range
  
    With searchRange
        Set LastCell = .Cells(.Cells.Count)
    End With
    Set findRange = searchRange.Find(what:=findWhat, after:=LastCell)
End Function

 

[Ironman]

Thanks Sid - I just tried that and when I double click Col B nothing happens. When I double click Col E I get the MsgBox "Invalid search - double click ROUTE # cell only", vbCritical, "Invalid Cell Selection".

What I'm trying to avoid is the intermittent - and incorrect "Invalid search - double click ROUTE # cell only" msgbox when I double click Col B. Double clicking Col E, then double clicking Col B runs the macro every time (but I can't figure out a consistent occasion when double clicking the range in Col B doesn't work and I get the msgbox instead) so the solution I'm looking for is to double click the range in Col B and instead of getting the msgbox, the macro automatically then double clicks the named range in Col E (which is the same range as Col B) and then Col B again and the Col B macro then runs.

 

[Siddharth Rout]

What my understanding was range "AnalysisRoutesList" is in Col E. When you click in that range, the "Find" should happen based on the range B in the same row. I think I may have misunderstood? Couple of questions.

1. What should happen when you click on a cell in Col B?
2. What should happen when you click on a cell in Col E?
3. Where is the range "AnalysisRoutesList"?

 

[Ironman]

Sorry for the confusion Sid.

1. When I click on a cell in the current range B446:B470 (rows are added in between those cells, not below B470) the below code runs a search of the sheet (even though it only needs to search Col F) for the cell I have just double clicked but without the "." i.e. Rxx (where xx is a number between 1 and 99)

searchStr = Replace(rng.Value, ".", "")
        Set foundRange = findRange(ActiveSheet.UsedRange, searchStr)
      
        If Not foundRange Is Nothing Then
            foundRange.Select
        Else
            MsgBox "Invalid search - double click ROUTE # cell only", vbCritical, "Invalid Cell Selection"
        End If

Here's what the range looks like right now:

DIST	R(OUTE) #	AVE TIME	#RUNS	ROUTE DETAILS
2.2	R.32	0:28:02	18	Cullingworth Road/Viaduct (up and down)/Halifax Road/Greenside Lane
3.0	R.29	0:37:38	12	Cullingworth Road/Up viaduct/Down Station Road/Back up/Down viaduct/Halifax Road/Greenside Lane
4.2	R.33	0:56:04	55	Cullingworth Road/Viaduct/Station Road/Lane Side/Ling Bob/Wilsden Road/Bents Lane/Hallas Bridge
5.0	R.34	1:08:15	27	Cullingworth Road/Viaduct/Station Road/Lane Side/Ling Bob/Haworth Road/Shay Lane/Crack Lane/Main Street/Bents Lane/Hallas Bridge
5.4	R.35	1:12:48	14	Cullingworth Road/Viaduct/Station Road/Lane Side/Ling Bob/Haworth Road/Shay Lane/Coplowe Lane/Cross Lane/Smithy Lane/Main Street/Bents Lane/Hallas Bridge
5.9	R.55	1:15:40	3	Cullingworth Road/Viaduct/Stn Road/Old Allen Rd/HARROP LN/Old Allen Rd/Back Lane/Shay Lane/Crack Lane/Main Street/Bents Lane/Hallas Bridge
6.2	R.47	1:21:42	12	Cullingworth Road/Viaduct/Stn Road/Old Allen Rd/Back Lane/Shay Lane/Crack Lane/Main Street/Bents Lane/Hallas Bridge
6.5	R.48	1:39:34	3	Cullingworth Road/Viaduct/Stn Road/Old Allen Rd/Back Lane/Shay Lane/Cross Lane/Smithy Lane/Main Street/Bents Ln/Hallas Bridge
6.7	R.41	1:27:02	9	Cullingworth Road/Shay Lane/Crack Lane/Main Street/Harden Lane/Mill Hill Top/Wilsden Road/Mad Mile/Home
6.9	R.54	1:26:13	6	Haworth Road/Flappit/Brow Top Rd/Black Moor Rd/Denholme Rd/Trough Ln/Manywells Brow/Cullingworth Rd/Hallas Ln
7.0	R.36	1:31:03	9	Cullingworth Road/Viaduct/Station Road/Lane Side/Ling Bob/Haworth Road/Wilsden Road/Cottingley Road/Lee Lane/Cross Lane/Smithy Lane/Wilsden Road/Bents Lane/Hallas Bridge
7.0	R.39	1:32:48	4	Cullingworth Road/Viaduct/Ling Bob/Haworth Road/Shay Lane/Coplowe Lane/Smithy Lane/Main Street/Harden Lane/Mill Hill Top/Wilsden Road/Mad Mile/Greenside Lane
7.7	R.37	1:42:58	25	Cullingworth Road/Viaduct/Station Road/Lane Side/Ling Bob/Haworth Road/Wilsden Road/Cottingley Road/Lee Lane/Cross Lane/Coplowe Lane/Crack Lane/Main Street/Bents Lane/Hallas Bridge
8.7	R.42	1:53:15	1	Cullingworth Road/Viaduct/Harecroft/Ling Bob/Wilsden Road/Cottingley Road/Lee Lane/Cross Lane/Coplowe Lane/Smithy Lane/Main Street/Harden Lane/Mill Hill Top/Wilsden Road/Mad Mile/Greenside Lane
8.8	R.49	2:03:45	9	Cullingworth Road/Viaduct/Stn Road/Old Allen Road/Back Lane/Wilsden Rd/Cottingley Rd/Lee Lane/Cross Lane/Coplowe Ln/Crack Lane/Main Street/ Bents Lane/Hallas Bridge
8.9	R.56	1:50:04	4	Cullingworth Rd/Haworth Rd/Flappit/Brow Top Rd/Black Moor Rd/Denholme Rd/Trough Ln/Halifax Rd Flappit/Haworth Rd/Turf Ln/Station Rd/Greenside Ln
9.4	R.38	2:04:56	23	Cullingworth Road/Viaduct/Harecroft/Ling Bob/Wilsden Road/Cottingley Road/Lee Lane/Cross Lane/Coplowe Lane/Crack Lane/Main Street/Harden Lane/Wilsden Road/Mad Mile/Home
9.9	R.52	2:16:08	4	Cullingworth Road/Haworth Rd/Flappit/L Halifax Rd/Trough Ln/Denholme Rd/Station Rd (Oxenhope)/Moorhouse Ln/R Marsh Ln (Haworth)/Sun St/Bridgehouse Ln/Brow Rd/Brow Top Rd/Haworth Rd/Turf Ln/Station Rd/Greenside Ln
10.4	R.14	2:31:17	30	Hallas Br/Down Bents Ln/Up Harden/Smithy/Lee Farm/Black Hills/Golf Course/Beck Foot Ln/Wagon Ln/Up LLC to top of 5-Rise Locks/Back to 3-Rise Locks & over Br/Brown Cow/Main Rd home
10.6	R.46	2:22:01	24	Cullingworth Road/Viaduct/Stn Road/Old Allen Road/Back Lane/Wilsden Rd/Cottingley Rd/Lee Lane/Cross Lane/Coplowe Ln/Crack Lane/Main Street/Harden Ln/Mill Hill Top/Wilsden Rd/Mad Mile/Greenside Lane
11.4	R.50	2:49:06	3	Hallas Br/Down Bents Ln/Up Harden Lane/Smithy Ln/Lee Farm/Black Hills/Golf Course/R Beck Foot Lane/Wagon Lane/Up LLC across first jctn to post/Back to 3-Rise Locks & over Bridge/Brown Cow/Main Road all the way back
12.1	R.53	2:41:36	6	Cull Rd/Hwth Rd/Hfx Rd/Trough Ln/Stn Rd (Oxen)/Hebden Br Rd/Shaw Ln/Moorside Ln/Reservoir Rd/Sun Ln (Stanbury)/Main St (Sladen Br)/West Ln/Main St (Hwth)/Brow Rd/Brow Top Rd/Hwth Rd/Turf Ln/Stn Road/Greenside
13.1	R.51	3:16:13	3	Hallas Br/Bents Ln/Harden Ln/Smithy Ln/X Ln/Blackhills/Golf Course/Beck Foot Ln/Wagon Ln/Down LLC to Hirst Wood Lock (to post)/Back up, past 5RL to 1st road jct./Back down & over 3RL/Brown Cow/Main Rd home
15.4	R.57	3:43:20	6	Hallas Br/Bents Ln/Harden Ln/Smithy Ln/Lee Fm/Blackhills/Golf Course/R down Beck Foot Ln/Wagon Ln/Up LLC, over Granby Ln jct & round cannon/Back to 3-Rise Locks & over Br/Brown Cow/Main Road home

And here are 3 examples of the R numbers (without the ".") that it's searching for:

ROUTE R55 (5.95M, LOGGED AS 5.9M) - Cullingworth Rd/Viaduct/Stn Road/Old Allen Rd/Harrop Ln/Old Allen Rd/Back Lane/Shay Lane/Crack Lane/Main Street/Bents Lane/Hallas Bridge
ROUTE R56 (8.9M) - Cullingworth Rd/Haworth Rd/Flappit/Brow Top Rd/Black Moor Rd/Denholme Rd/Trough Ln/Halifax Rd Flappit/Haworth Rd/Turf Ln/Station Rd/Greenside Ln
ROUTE R57 (15.4M) - Hallas Br/Bents Ln/Harden Ln/Smithy Ln/Lee Fm/Blackhills/Golf Course/R down Beck Foot Ln/Wagon Ln/Up LLC, over Granby Ln jct & round cannon/Back to 3-Rise Locks & over Br/Brown Cow/Main Road home

3. Range "AnalysisRoutesList" is all the rows below the ROUTE DETAILS heading, including the blank row below them.

Thanks again.

 

[Siddharth Rout]

So here is my understanding... Please correct me if I am wrong.

1. When you double click in Column B then you want to replace "." with "" in Route# and then search that in Col F and if found select that cell.
2. When you double click on the named range then, it should pick up the value of cell B in the same row and then replace "." with "" in Route# and then search that in Col F and if found select that cell.

And if my understanding is correct then try this

Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    On Error GoTo Whoa
   
    Application.EnableEvents = False
   
    Dim searchStr As String
    Dim rng As Range
    Dim foundRange As Range
   
    If Not Intersect(Target, Range("AnalysisRoutesList")) Is Nothing Or _
    Not Intersect(Target, Columns(2)) Is Nothing Then
        findRange Range("B" & Target.Row)
        Cancel = True
    End If
       
Letscontinue:
    Application.EnableEvents = True
    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume Letscontinue
End Sub

Function findRange(rngRange As Range) As Range
    Dim searchStr As String
    searchStr = Replace(rngRange.Value, ".", "")
    
    Dim foundRange As Range
    Set foundRange = Columns(6).Find(What:=searchStr, _
                                Lookat:=xlPart, _
                                LookIn:=xlFormulas, _
                                SearchOrder:=xlByRows, _
                                SearchDirection:=xlPrevious, _
                                MatchCase:=False)
    
    If Not foundRange Is Nothing Then
        foundRange.Select
    Else
        MsgBox "Invalid search - double click ROUTE # cell only", vbCritical, "Invalid Cell Selection"
    End If
End Function

 

[Siddharth Rout]

Cleaned up code Code

Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    On Error GoTo Whoa
   
    Application.EnableEvents = False
   
    If Not Intersect(Target, Range("AnalysisRoutesList")) Is Nothing Or _
    Not Intersect(Target, Columns(2)) Is Nothing Then
        findRange Range("B" & Target.Row)
        Cancel = True
    End If
       
Letscontinue:
    Application.EnableEvents = True
    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume Letscontinue
End Sub

Function findRange(rngRange As Range) As Range
    Dim searchStr As String
    searchStr = Replace(rngRange.Value, ".", "")
    
    Dim foundRange As Range
    Set foundRange = Columns(6).Find(What:=searchStr, _
                                Lookat:=xlPart, _
                                LookIn:=xlFormulas, _
                                SearchOrder:=xlByRows, _
                                SearchDirection:=xlPrevious, _
                                MatchCase:=False)
    
    If Not foundRange Is Nothing Then
        foundRange.Select
    Else
        MsgBox "Invalid search - double click ROUTE # cell only", vbCritical, "Invalid Cell Selection"
    End If
End Function

 

[Ironman]

Hey Sid that works great, thank you!

Would it be possible for you to modify your code just slightly, so if I get the error when double clicking Col B, then it automatically runs the same search function in the named range in Col F as if I double clicked it myself, instead of me needing to manually double click it myself?

Thanks again, you're almost there!