Using VBA with the “selection” of non-active worksheets

Question

Sorry for a potential "bad" title, I wasn't sure how to phrase it. Feel free to edit if you have a better wording.

This is a follow-up on a previous question . As far as I researched there is no solution but maybe I overlooked something.

In a workbook with more then worksheet if I change the selection of the active worksheet (manually or via VBA) the selected range of the non-active sheets won't be affected, so the value must be stored somehow.

Using "the regular commands" ( set range = selection , range.select , etc.) requires the cosponsoring sheets to be active. This makes sense since the selection, select etc. applies to the "currently active selection".

But still, the "selection" of non active sheet must be stored somewhere. Is there a way to get those values or even manipulate them?

Appendix1: I thought this was implied: I don't want to change the active sheet (otherwise I could just use the regular select commands).

Appendix2: It's not just about what you see on the screen. I want to avoid activating a different sheet so I don't have to have to handle the activation of the initially activated sheet altogether - this is my current solution (instead I want sort of a "true" separation of view and controller). I don't think the "regular" API will provide this, but I though there might be some other work around. But thanks for your suggestion anyway.

Answer 1

But still, the "selection" of non active sheet must be stored somewhere. Is there a way to get those values or even manipulate them?

@Pᴇʜ already has given you 1 way. Here are two ways I can think of.

1. Way 1: Loop through the sheets, activate them and then get the Selection.Address . I have not done error handling so you will have to use If TypeName(Selection) <> "Range" Then to handle situations if say a shape is selected.

2. Way 2: Create a copy of the current excel file in user temp directory. Rename it to .Zip . Unzip the zip file. Next go to xl\\worksheets folder in the zip file and loop through each Sheets.xml file. Extract the relevant detail from there.

Easy Way (Way 1)

Option Explicit

Sub WayOne()
    Dim ws As Worksheet
    Dim msg As String
    
    For Each ws In ThisWorkbook.Worksheets
        If ws.Visible = xlSheetVisible Then
            ws.Activate
        
            msg = msg & vbNewLine & ws.Name & " -- " & Selection.Address
        End If
    Next ws
    
    Msgbox Mid(msg, 2)
End Sub

Alternative Way (Way 2) Not completely tested

Option Explicit
    
Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" _
(ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long

Private Const MAX_PATH As Long = 260

Sub Way2()
    Dim thisFileName As String
    Dim FileNameFolder As String
    Dim oldFileName As String
    Dim newFileName As Variant
    Dim UnzipFolder As String
    Dim tmpName As String
    
    '~~> Get a unique mame for the temp folder and zip file
    tmpName = Format(Now, "ddmmyyyyhhmmss")
    
    '~~> Get this workbooks name
    thisFileName = ThisWorkbook.Name
    
    '~~> Temp folder
    FileNameFolder = TempPath & tmpName
    
    '~~> Make the folder
    MkDir FileNameFolder
    DoEvents
    
    '~~> Folder to unzip files in the above folder
    UnzipFolder = FileNameFolder & "\UnzipFolder"
    
    '~~> Make the folder
    MkDir UnzipFolder
    DoEvents
    
    '~~> Name of file with which the current file will saved
    oldFileName = FileNameFolder & "\" & thisFileName
    '~~> Name of the zip file
    newFileName = FileNameFolder & "\" & tmpName & ".zip"
    
    '~~> Save a copy of this folder
    ThisWorkbook.SaveCopyAs (oldFileName)
    DoEvents
    
    '~~> Rename the file
    Name oldFileName As newFileName
    
    '~~> Unzip the files
    Dim oApp As Object
    Set oApp = CreateObject("Shell.Application")
    oApp.Namespace(UnzipFolder & "\").CopyHere oApp.Namespace(newFileName).items
    
    '~~> Identify our working folder
    Dim Workingfolder As String
    Workingfolder = UnzipFolder & "\xl\worksheets\"
    
    Dim StrFile As String
    StrFile = Dir(Workingfolder & "\*.xml")
    
    Dim MyData As String
    Dim SheetName As String
    Dim rngaddr As String
    
    '~~> Loop through the xml files to extract relevant details
    Do While Len(StrFile) > 0
        Open Workingfolder & StrFile For Binary As #1
        MyData = Space$(LOF(1))
        Get #1, , MyData
        Close #1
        
        '~~> Get Sheet name
        SheetName = GetValue(MyData, "N")
        '~~> Get Range address
        rngaddr = GetValue(MyData, "R")
        
        Debug.Print SheetName & " - " & rngaddr
        StrFile = Dir
    Loop
    
    '~~> Cleanup. Delete the temp folder
    Dim FSO As Object
    Set FSO = CreateObject("scripting.filesystemobject")
    FSO.deletefolder FileNameFolder
End Sub

Private Function GetValue(dat As String, opt As String) As String
    Dim Delim As String
    Dim tmpValue As String
    
    If opt = "N" Then
        '~~> For sheet name
        Delim = "<sheetPr codeName="""
    Else
        '~~> For multiple cell address
        Delim = "<selection sqref="""
        If InStr(1, dat, Delim) = 0 Then
            '~~> For Single cell address
            Delim = "<selection activeCell="""
        End If
    End If
    
    If InStr(1, dat, Delim) Then
        tmpValue = Split(dat, Delim)(1)
        tmpValue = Split(tmpValue, Chr(34))(0)
    Else
        tmpValue = "A1"
    End If
    
    GetValue = tmpValue
End Function

'~~> Get user temp path
Function TempPath() As String
    TempPath = String$(MAX_PATH, Chr$(0))
    GetTempPath MAX_PATH, TempPath
    TempPath = Replace(TempPath, Chr$(0), "")
End Function

In Action

Answer 2

I guess this is only possible with a workaround, because per definition Selection only exists once in Excel, because it is Application.Selection and we have no access to the hidden value were Excel remembers this for each worksheet.

Write into ThisWorkbook scope:

Option Explicit

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    SaveAddress Selection
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    SaveAddress Target
End Sub

Write into a module:

Option Explicit

Public SelectionAddresses As Object

Public Sub SaveAddress(ByVal Target As Range)
    On Error GoTo CREATE_DICTIONARY
    
    If SelectionAddresses.Exists(Target.Parent.Name) Then
        SelectionAddresses(Target.Parent.Name) = Target.Address
    Else
        SelectionAddresses.Add Target.Parent.Name, Target.Address
    End If
    
    Exit Sub
CREATE_DICTIONARY:
    If Err.Number = 91 Then
        Set SelectionAddresses = CreateObject("Scripting.Dictionary")
        InitializeAddresses
        Resume
    Else
        Err.Raise Err.Number, Err.Source, Err.Description, Err.HelpFile, Err.HelpContext
    End If
End Sub

Public Sub ListAddresses()
    Dim Key As Variant
    For Each Key In SelectionAddresses
        Debug.Print Key, SelectionAddresses(Key)
    Next Key
End Sub

Public Sub InitializeAddresses()
    Dim ActWs As Worksheet
    Set ActWs = ActiveSheet
    Application.ScreenUpdating = False
    Dim ws As Worksheet
    For Each ws In ThisWorkbook.Worksheets
        ws.Activate
    Next ws
    
    ActWs.Activate
    Application.ScreenUpdating = True
End Sub

Public Function GetSelectionAddressOfSheet(ByVal SheetName As String) As String
    On Error GoTo NOT_FOUND
    If SelectionAddresses.Exists(SheetName) Then
        GetSelectionAddressOfSheet = SelectionAddresses(SheetName)
    Else
        GoTo NOT_FOUND
    End If
    
    Exit Function
NOT_FOUND:
    GetSelectionAddressOfSheet = "not found" 'or vbNullString
    On Error GoTo 0
End Function

This will save the selection address of every sheet into a dictionary SelectionAddresses where you can then read it from. Eg with

Debug.Print GetSelectionAddressOfSheet("Sheet2")

You might want to use an additional

Private Sub Workbook_Open()
    InitializeAddresses
End Sub

So the dictionary gets initialized immediately after opening the workbook.