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)

    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