Go to cell in other sheet based on value in double clicked cell

[DataPanda]

Hi.

I'm trying to write some VBA in a rush but haven't had time to properly learn it to struggling a bit

What I want, is that when someone clicks or double clicks on a cell in Column B Sheet 1 (e.g. folder B), then the VBA will look at the adjacent Column A Sheet 1 (which will be hidden) and find the value there (e.g. C:/folderA/folderB). It will search Column A Sheet 2 for this value and (a) set that as the active cell and (b) set it to be the top-left cell on the screen.

I've identified some VBA that may help, I just don't know how to put it all together:

' Set cell as the top left cell
Application.Goto <something here>, True

` Change active cell to cell on the left
ActiveCell.Offset(0, -1)

Sheet 1:

FOLDERS (column A Sheet 1)	CONTENTS (column B Sheet 1)
C:/folderA	folderA
C:/folderA/folderB	folderB
C:/folderC	folderC
C:folderD	folderD

Sheet 2:

PATHS (column A Sheet 2)
C:/folderA
C:/folderA/folderB
C:/folderA/folderB/fileA.txt
C:/folderC
C:/folderC/fileB.txt
C:folderD

 

[rlv01]

Sheet1

Book8 (version 1).xlsb
	A	B
1	Folders	Contents
2	C:/folderA	folderA
3	C:/folderA/folderB	folderB
4	C:/folderC	folderC
5	C:folderD	folderD
6	C:/folderX	folderX
Sheet1

Sheet2

Book8 (version 1).xlsb
	A
1	Paths
2	C:/folderA
3	C:/folderA/folderB
4	C:/folderA/folderB/fileA.txt
5	C:/folderC
6	C:/folderC/fileB.txt
7	C:folderD
Sheet2

Code must be located in the Sheet1 code module.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim SearchTerm As String
    Dim WS As Worksheet
    Dim rngFound As Range

    If Not Application.Intersect(Target, Me.Columns("B")) Is Nothing And Target.Cells.Count = 1 Then
        SearchTerm = Target.Offset(0, -1).Value
        If Trim(SearchTerm) <> "" Then
            Set WS = ThisWorkbook.Worksheets("Sheet2")
            With WS
                Set rngFound = .Range("A2", .Range("A" & .Rows.Count).End(xlUp)).Find(What:=SearchTerm, LookAt:=xlWhole)
            End With
            If Not rngFound Is Nothing Then
                WS.Activate
                rngFound.Select
            Else
                MsgBox "'" & SearchTerm & "' not found"
            End If
        End If
    End If
End Sub

 

[DataPanda]

Sheet1

Book8 (version 1).xlsb
	A	B
1	Folders	Contents
2	C:/folderA	folderA
3	C:/folderA/folderB	folderB
4	C:/folderC	folderC
5	C:folderD	folderD
6	C:/folderX	folderX
Sheet1

Sheet2

Book8 (version 1).xlsb
	A
1	Paths
2	C:/folderA
3	C:/folderA/folderB
4	C:/folderA/folderB/fileA.txt
5	C:/folderC
6	C:/folderC/fileB.txt
7	C:folderD
Sheet2

Code must be located in the Sheet1 code module.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim SearchTerm As String
    Dim WS As Worksheet
    Dim rngFound As Range

    If Not Application.Intersect(Target, Me.Columns("B")) Is Nothing And Target.Cells.Count = 1 Then
        SearchTerm = Target.Offset(0, -1).Value
        If Trim(SearchTerm) <> "" Then
            Set WS = ThisWorkbook.Worksheets("Sheet2")
            With WS
                Set rngFound = .Range("A2", .Range("A" & .Rows.Count).End(xlUp)).Find(What:=SearchTerm, LookAt:=xlWhole)
            End With
            If Not rngFound Is Nothing Then
                WS.Activate
                rngFound.Select
            Else
                MsgBox "'" & SearchTerm & "' not found"
            End If
        End If
    End If
End Sub

Thank you!

I did get something working in the end. But will try this next week when I'm in the office again and see how it compares.

 

[Peter_SSs]

I would go for the double-click event so that the code is not firing so much of the time. This code includes this requirement:

and (b) set it to be the top-left cell on the screen.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  Dim rFound As Range
  
  If Not Intersect(Target, Columns("B")) Is Nothing Then
    Cancel = True
    Set rFound = Sheets("Sheet2").Columns("A").Find(What:=Target.Offset(, -1).Value, LookAt:=xlWhole)
    If rFound Is Nothing Then
      MsgBox Target.Offset(, -1).Value & " not found"
    Else
      Application.Goto Reference:=rFound, Scroll:=True
    End If
  End If
End Sub

If you would prefer to use the selection change event ..

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Dim rFound As Range
  
  If Not Intersect(ActiveCell, Columns("B")) Is Nothing Then
    Set rFound = Sheets("Sheet2").Columns("A").Find(What:=ActiveCell.Offset(, -1).Value, LookAt:=xlWhole)
    If rFound Is Nothing Then
      MsgBox ActiveCell.Offset(, -1).Value & " not found"
    Else
      Application.Goto Reference:=rFound, Scroll:=True
    End If
  End If
End Sub

 

[rlv01]

If you would prefer to use the selection change event ..

The problem with using If Not Intersect(ActiveCell, Columns("B")) Is Nothing Then instead of
If Not Application.Intersect(Target, Me.Columns("B")) Is Nothing And Target.Cells.Count = 1 Then for the selection event is that any operation that selects more than one cell (such as deciding to copy data from col B to somewhere else) will result in a runtime error.

Edit: No runtime error on your code, I see. But it still jumps the user away from the selected cells.

 

[DataPanda]

I would go for the double-click event so that the code is not firing so much of the time. This code includes this requirement:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  Dim rFound As Range
 
  If Not Intersect(Target, Columns("B")) Is Nothing Then
    Cancel = True
    Set rFound = Sheets("Sheet2").Columns("A").Find(What:=Target.Offset(, -1).Value, LookAt:=xlWhole)
    If rFound Is Nothing Then
      MsgBox Target.Offset(, -1).Value & " not found"
    Else
      Application.Goto Reference:=rFound, Scroll:=True
    End If
  End If
End Sub

If you would prefer to use the selection change event ..

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Dim rFound As Range
 
  If Not Intersect(ActiveCell, Columns("B")) Is Nothing Then
    Set rFound = Sheets("Sheet2").Columns("A").Find(What:=ActiveCell.Offset(, -1).Value, LookAt:=xlWhole)
    If rFound Is Nothing Then
      MsgBox ActiveCell.Offset(, -1).Value & " not found"
    Else
      Application.Goto Reference:=rFound, Scroll:=True
    End If
  End If
End Sub

Thank you. I had tried your first bit of code, as the `BeforeDoubleClick` event I think is what I want. However I did seem to get an out of range issue for the line that starts `Set`. I'll look into more closely when I'm next online.

 

[Peter_SSs]

However I did seem to get an out of range issue for the line that starts `Set`.

That would most likely be because the sheet name in the code does not match a sheet name in your workbook.

Set rFound = Sheets("Sheet2").Columns("A").Find(What:=Target.Offset(, -1).Value, LookAt:=xlWhole)

(such as deciding to copy data from col B to somewhere else) ...

.... But it still jumps the user away from the selected cells.

The issues does not seem to be relevant to the OP but in any case that would be the same issue with your code if you wanted to copy a single cell from col B to somewhere else.