Search code examples
excelvbahyperlinkcellworksheet

How can I get cell in worksheet of an workbook which is hyperlinked in a cell?


I have a cell range which can contain hyperlinks to other Excel data.
Hyperlink in a cell]

I need to get a specific cell in a specific worksheet of that hyperlink.

I tried pulling the worksheet at first like this:

AktiveWorkbook.Sheets.Add Before:=c.Hyperlinks.Application.Worksheets(1)

The best option would be that I do not have to pull the worksheet.

I am in a workbook, where you can find in cell A1 the value "C:\Users\z0\Downloads\GG.xlsm", which is the path of a closed workbook.

I am trying to get, for example, the A1 cell of Sheet1 of the closed workbook and paste the value to, let's say, B1 in the workbook where you can also find the path.

I tried:

Dim wb As Workbook: Set wb = ThisWorkbook
Dim sh As Worksheet: Set sh = wb.Worksheets(1)
Dim cell As Range: Set cell = sh.Range("A1:A1000")
Dim pth As String
Dim qafWb As Workbook

pth = Replace(Range("A1").Value, "\", "/")
qafWb = Workbooks(pth)
sh.Range("B2") = qafWb.Worksheets(1).Range("G13")

The compiler is saying that the variable qafWb does contain "Nothing".


Solution

  • Write Formula Using 'Hyper' Cell (VBA)

    • It is assumed that the formula in the 'hyper' cell is something like

      =HYPERLINK("C:\Users\z0\Downloads\GG.xlsm","Whatever")
      
    Sub WriteFormulaUsingHyperCell()
       
        Const SRC_SHEET_NAME As String = "Sheet1"
        Const SRC_CELL As String = "A1"
        
        Const DST_SHEET_NAME As String = "Sheet1"
        Const DST_HYPER_CELL As String = "A1"
        Const DST_FORMULA_CELL As String = "B1"
        Const NOT_FOUND_STRING As String = "Not found"
        
        Dim IsSuccess As Boolean
        
        Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
        Dim dws As Worksheet: Set dws = wb.Sheets(DST_SHEET_NAME)
        
        Dim hStr As String: hStr = dws.Range(DST_HYPER_CELL).Formula
        Dim hParts() As String: hParts = Split(hStr, """")
        If UBound(hParts) < 1 Then GoTo WriteResult ' no double quotes
        
        Dim sFilePath As String: sFilePath = hParts(1)
        Dim Position As Long: Position = InStrRev(sFilePath, "\")
        If Position = 0 Then GoTo WriteResult ' no backslashes
                    
        Dim sFolderPath As String: sFolderPath = Left(sFilePath, Position)
        Dim sFileName As String:
        sFileName = Right(sFilePath, Len(sFilePath) - Position)
        
        Dim dFormula As String: dFormula = "='" & sFolderPath & "[" & sFileName _
            & "]" & SRC_SHEET_NAME & "'!" & SRC_CELL
        
        IsSuccess = True
        
        'Debug.Print sFilePath
        'Debug.Print sFileName
        'Debug.Print dFormula
        
    WriteResult:
        
        With dws.Range(DST_FORMULA_CELL)
            If IsSuccess Then
                .Formula = dFormula
            Else
                .Value = NOT_FOUND_STRING
            End If
        End With
        
    End Sub