Replace cell values with a link to the data validation list automatically

In Excel the Data validation with a reference to a given list of choices is a great feature to simplify data entries with in-cell drop-down menus. However if any of the items in the validation list gets renamend, or changed later on, the entries in the worksheet don’t get updated since no link is present. This can be overcome by replacing the static cell value with a link to the validation list. This can be automated by using the Worksheet change event.

Microsoft Excel Object Worksheet

Option Explicit 
 
Private Sub Worksheet_Change(ByVal Target As Range) 
'———————————————————————————————————————————————————————————————————————————————————— 
' 1. entries in this sheet are being replaced with a link to the validation list 
    Call replace_cell_entry_with_link(Target) 

End Sub

Std. Code Module

Option Explicit 
 
Sub replace_cell_entry_with_link(ByVal Target As Range) 
' for cells with data validation based on lists it replaces the selected entry from the list with a link to the selected list item 
' being called by the "Worksheet_Change"-Event set-up in the code mdule of the relevant worksheet objects 
   Dim c As Range, lnkCell As Range 
   Dim s As String, f As String 
   With Application 
      .EnableEvents = False 
      .ScreenUpdating = False 
      On Error GoTo nextone 
      For Each c In Target.Cells 
         If c.Validation.Type = xlValidateList Then  ' xlValidateList=3 see http://msdn.microsoft.com/en-us/library/office/ff840715(v=office.15).aspx 
            s = c.Formula  'the actual value that has been entered in the cell 
            If s <> "" And Left(s, 1) <> "=" Then   ' if not empty or a formula 
               f = Mid(c.Validation.Formula1, 2)   ' we need the validation string without the "=" sign 
               If Application.ReferenceStyle = xlR1C1 Then   'we convert if required 
                  f = Application.ConvertFormula(f, fromreferencestyle:=xlR1C1, toreferencestyle:=xlA1) 
               End If 
               ' now 2 attempts to get the cell adress of the list item in the validation list 
               Set lnkCell = Application.Range(f).Find(c.Value, LookIn:=xlValues, LookAt:=xlWhole) 
               If lnkCell Is Nothing Then 
                  Set lnkCell = Application.Range(f).Find(c.Value, LookIn:=xlFormulas, LookAt:=xlWhole) 
               End If 
 
               If Not lnkCell Is Nothing Then  ' address has been found 🙂 
                  With lnkCell.Worksheet 
                     c.Formula = "='" & .Name & "'!" & lnkCell.Address 
                     c.Font.ColorIndex = 14 
                  End With 
                  Set lnkCell = Nothing 
               End If 
            End If 
         End If 
nextone: 
      Next c 
      .EnableEvents = True 
      .ScreenUpdating = True 
   End With 
End Sub 

MacroLister – A popup menu to access all VBA macros for starting or editing

To have an easy access to any and all macros that are anywhere present in the open documnets or loaded addins a little addin has been created that makes all macros accessible via a popup menu structure. The commandbar has two objects. A: the Macro popup menu structure itself, and B: a button to renew the menu when required. When the application is started only a “Starter” button is there to avoid any delay in application start-up times for building the popup menu tree when very many Addins with lots of macros are installed.

Microsoft Excel Object ThisWorkbook

'--------------------------------------------------------------------------- 
' Module    : ThisWorkbook 
' Author    : Hartmut Gruenhagen 
' Date      : 06-Feb-14 
' Purpose   : Adds commandbar for the Macrolister to the Addins-menu 
'--------------------------------------------------------------------------- 
 
Option Explicit 
 
Private Sub Workbook_BeforeClose(Cancel As Boolean) 
    On Error Resume Next 
    Application.CommandBars(myCmdbarLoader).Delete 
    Application.CommandBars(myCmdbarTitle).Delete 
    On Error GoTo 0 
End Sub 
 
Private Sub Workbook_Open() 
    Call BuildMenu 
End Sub 

Module VBA_MacroLister

'-------------------------------------------------------------------------- 
' Module    : VBA_MacroLister 
' Author    : Hartmut Gruenhagen 
' Date      : 06-Feb-14 
' Purpose   : Macrolister Code module that builds the popup menu structure 
'-------------------------------------------------------------------------- 
 
Option Explicit 
 
Global TheMacroFile As String 
 
#If VBA7 Then 
Public Declare PtrSafe Function GetAsyncKeyState Lib _
       "user32.dll" (ByVal vKey As Long) As Integer 
#Else 
Public Declare Function GetAsyncKeyState Lib "user32.dll" _
                                         (ByVal vKey As Long) As Integer 
#End If 
 
Const myPopup = "MacroLister" 
 
Public Const myCmdbarTitle = "MacroMenuTree" 
Public Const myCmdbarLoader = "MacroTreeLoader" 
 
Private myCmdbar As CommandBar 
 
Sub BuildMenu() 
   Dim j As Long 
   Dim PopupA As CommandBarControl 
   With Application.CommandBars(1) 
      On Error Resume Next 
      .Controls(myPopup).Delete 
      On Error GoTo 0 
      Set PopupA = .Controls.Add(Type:=msoControlPopup, _
                                 Before:=.FindControl(ID:=30010).Index, _
                                 Temporary:=True) 
   End With 
   ' 
   With PopupA 
      .Caption = myPopup 
      ' 
      ' Build and show Macro Popup menu 
      ' 
      With .Controls.Add(Type:=msoControlButton) 
         .Caption = "Load Macro Menu" 
         .OnAction = "BuildAndShowCmdbar" 
         .TooltipText = "Build VBA Macro List Menu Tree" 
         .Style = MsoButtonStyle.msoButtonIconAndCaption 
         .FaceId = 420 
         .Enabled = True 
      End With 
   End With 
End Sub 
 
Sub BuildAndShowCmdbar() 
   On Error Resume Next 
   ' destroy old custom menu and rebuild from scratch 
   Application.CommandBars(myCmdbarTitle).Delete 
   On Error GoTo 0 
   Set myCmdbar = Application.CommandBars.Add(myCmdbarTitle, _
                                              MsoBarPosition.msoBarTop, _
                                              MsoBarType.msoBarTypeNormal, True) 
 
   With myCmdbar.Controls 
      Do While .Count > 0 
         .Item(.Count).Delete  ' deleting the old entries 
      Loop 
   End With 
   Dim myVBP As VBProject 
 
   Dim aProjPopUp As CommandBarPopup 
   Dim aButton As CommandBarButton 
   Dim VBComp As VBIDE.VBComponent 
   Dim VBlines As Long 
   Dim MasterPopUp As CommandBarPopup 
   Dim sWbName As String 
   Dim i As Long 
 
   Dim wasProtected As Boolean 
   wasProtected = False 
   Set MasterPopUp = myCmdbar.Controls.Add(msoControlPopup) 
   MasterPopUp.Caption = "Macros" 
 
   For Each myVBP In Application.VBE.VBProjects 
      On Error GoTo protectedXLA 
      For Each VBComp In myVBP.VBComponents 
         If wasProtected Then 
            wasProtected = False 
            GoTo jumptonext 
         End If 
         On Error GoTo 0 
         VBlines = TotalCodeLinesInVBComponent(VBComp) 
         If VBlines > 2 Then 
            ' usually 3 lines is the minimum for functional code 
            Set aProjPopUp = MasterPopUp.Controls.Add(msoControlPopup) 
            ' TheMacroFile is a global variable that is required in 
            ' "addRoutinesToPopup(..." 
            ' new unsaved files will create an error for "myVBP.Filename" 
            On Error Resume Next 
            sWbName = "" 
            sWbName = Dir(myVBP.Filename) 
            On Error GoTo 0 
            If Len(sWbName) = 0 Then 
Debug.Print "(Unsaved Workbook)" 
               TheMacroFile = "unsaved " & myVBP.Name 
            Else 
               TheMacroFile = Right(myVBP.Filename, Len(myVBP.Filename) - _
                                                    InStrRev(myVBP.Filename, _
                                                             "\", , vbTextCompare)) 
            End If 
            aProjPopUp.Caption = TheMacroFile 
            addCodemodulesToPopup aProjPopUp.CommandBar, myVBP 
            Exit For 
         End If 
         On Error GoTo protectedXLA 
      Next VBComp 
jumptonext: 
   Next myVBP 
   On Error GoTo 0 
   Set aButton = myCmdbar.Controls.Add 
   'Add values to the created new button. 
   With aButton 
      '.BeginGroup = True 
      .Caption = "Rebuild macro list" 
      .FaceId = 346 
      .OnAction = "BuildAndShowCmdbar" 
      .Style = MsoButtonStyle.msoButtonIcon 
      .TooltipText = "Rebuild macro list" 
      .Enabled = True 
   End With 
   myCmdbar.Visible = True 
   On Error Resume Next 
   Application.CommandBars(myCmdbarLoader).Delete 
   On Error GoTo 0 
   Exit Sub 
protectedXLA: 
   wasProtected = True 
   i = i + 1 
Debug.Print "protected project number : " & i 
   Set aProjPopUp = MasterPopUp.Controls.Add(msoControlPopup) 
   ' TheMacroFile is a global variable that is required in 
   ' "addRoutinesToPopup(..." 
   ' new unsaved files will create an error for "myVBP.Filename" 
   On Error Resume Next 
   sWbName = "" 
   sWbName = Dir(myVBP.Filename) 
   On Error GoTo 0 
   If Len(sWbName) = 0 Then 
Debug.Print "(Unsaved Workbook)" 
      TheMacroFile = "unsaved " & myVBP.Name 
   Else 
      TheMacroFile = Right(myVBP.Filename, Len(myVBP.Filename) - _
                                           InStrRev(myVBP.Filename, _
                                                    "\", , vbTextCompare)) 
   End If 
   aProjPopUp.Caption = TheMacroFile & " has VBA protection!" 
   '    aProjPopUp.FaceId = 330 
   Resume Next 
End Sub 
Function WorkbookOfVBProject(WhichVBP As Variant) As Workbook 
' by Chip Pearson 
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
' WorkbookOfVBProject 
' This returns the Workbook object for a specified VBIDE.VBProject. 
' The parameter WhichVBP can be any of the following: 
'   A VBIDE.VBProject object 
'   A string containing the name of the VBProject. 
'   The index number (ordinal position in Project window) of the VBProject. 
' 
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
   Dim WB As Workbook 
   Dim AI As AddIn 
   Dim VBP As VBIDE.VBProject 
 
   If IsObject(WhichVBP) = True Then 
      ' If WhichVBP is an object, it must be of the 
      ' type VBIDE.VBProject. Any other object type 
      ' throws an error 13 (type mismatch). 
      On Error GoTo 0 
      If TypeOf WhichVBP Is VBIDE.VBProject Then 
         Set VBP = WhichVBP 
      Else 
         Err.Raise 13 
      End If 
   Else 
      On Error Resume Next 
      Err.Clear 
      ' Here, WhichVBP is either the string name of 
      ' the VBP or its ordinal index number. 
      Set VBP = Application.VBE.VBProjects(WhichVBP) 
      On Error GoTo 0 
      If VBP Is Nothing Then 
         Err.Raise 9 
      End If 
   End If 
 
   For Each WB In Workbooks 
      If WB.VBProject Is VBP Then 
         Set WorkbookOfVBProject = WB 
         Exit Function 
      End If 
   Next WB 
   ' not found in workbooks, search installed add-ins. 
   For Each AI In Application.AddIns 
      If AI.Installed = True Then 
         If Workbooks(AI.Name).VBProject Is VBP Then 
            Set WorkbookOfVBProject = Workbooks(AI.Name) 
            Exit Function 
         End If 
      End If 
   Next AI 
 
End Function 
 
Public Sub MacroListPopup(Optional VBprojectName As String) 
' the main procedure to build the popup menu at run time and 
' to show it then to the user for normal use it should be 
' started via a menu and commandbar button. 
 
   Dim myaddin As AddIn 
   Dim myVBP As VBProject 
   Dim myBar As CommandBar 
   Dim ctrl As CommandBarButton 
   Dim a As AddIn 
   Dim s As String 
 
   If VBprojectName <> "" Then 
Debug.Print "MacroListPopup called w/ argument - VBprojectName: " _
            & VBprojectName 
      Set myVBP = Application.VBE.VBProjects(VBprojectName) 
   Else 
      '        Debug.Print "no VBprojectName" 
      Set ctrl = Application.CommandBars.ActionControl 
      If Not ctrl Is Nothing Then 
         s = ctrl.Parameter 
Debug.Print "VBproject name from Ctrl.Parameter: " & s 
      Else 
         s = ThisWorkbook.Name 
Debug.Print "VBproject name from ThisWorkbook.Name: " & s 
      End If 
 
      s = Right(s, Len(s) - InStrRev(s, "\", , vbTextCompare)) 
      If InStr(1, s, ".XLSB", vbTextCompare) > 0 Then 
         Set myVBP = Application.Workbooks(s & "b").VBProject 
      ElseIf InStr(1, s, ".XLS", vbTextCompare) > 0 Then 
         Set myVBP = Application.Workbooks(s).VBProject 
      Else 
         If Application.Name = "Microsoft Excel" Then 
            If Not ActiveWorkbook Is Nothing Then 
               If Not ctrl Is Nothing Then 
                  Set myaddin = AddIns.Add(ctrl.Parameter) 
                  Set myVBP = Application.Workbooks(myaddin.Name).VBProject 
               Else 
                  Set myVBP = Application.Workbooks(s).VBProject 
               End If 
            Else 
               s = Right(s, Len(s) - InStrRev(s, "\", , vbTextCompare)) 
               Set myVBP = Application.Workbooks(s).VBProject 
            End If 
         ElseIf Application.Name = "Microsoft PowerPoint" Then 
            Set myaddin = AddIns.Add(ctrl.Parameter) 
            Set myVBP = Application.Presentations(myaddin.Name).VBProject 
         End If 
      End If 
   End If 
 
   On Error Resume Next 
   ' destroy old custom menu and rebuild from scratch 
   Application.CommandBars("MacroList").Delete 
   On Error GoTo 0 
   Set myBar = Application.CommandBars.Add(Name:="MacroList", _
                                           Position:=msoBarPopup) 
 
   If Not myBar Is Nothing Then 
      TheMacroFile = Right(myVBP.Filename, Len(myVBP.Filename) - _
                                           InStrRev(myVBP.Filename, _
                                                    "\", , vbTextCompare)) 
      If myVBP Is Nothing Then   'Not open 
         MsgBox "No " & TheMacroFile & " macro file open!" & _
                Chr(10) & Chr(10) & "Cannot list macros.", _
                vbCritical, "myTools" 
         On Error GoTo 0 
      Else                     'macro file is open 
 
         addCodemodulesToPopup myBar, myVBP 
         ' we better sort the popup entries 
         On Error GoTo 0 
         SortCmdBar myBar      'aCmdbar 
         If Not ctrl Is Nothing Then 
            ' let the popup menu appear underneath the main 
            ' comandbar control that started this 
            myBar.ShowPopup x:=ctrl.Left, _
                            y:=ctrl.Top + myBar.Controls(1).Height 
         Else 
            myBar.ShowPopup x:=200, _
                            y:=200 + myBar.Controls(1).Height 
         End If 
         Set myVBP = Nothing 
      End If 
   End If 
End Sub 
 
Private Sub addCodemodulesToPopup(WindowCmdBar As CommandBar, _
                                  aVBProject As VBProject) 
   Dim aModulePopUp As CommandBarPopup 
   Dim VBComp As VBIDE.VBComponent 
   Dim VBlines As Long 
   Dim newForm As Boolean 
   Dim newModule As Boolean 
   Dim newClass As Boolean 
   On Error Resume Next 
   For Each VBComp In aVBProject.VBComponents 
      VBlines = TotalCodeLinesInVBComponent(VBComp) 
      If VBlines > 2 Then 
         ' usually 3 lines is the minimum for functional code 
         Set aModulePopUp = WindowCmdBar.Controls.Add(msoControlPopup) 
         Select Case VBComp.Type 
         Case vbext_ct_StdModule 
            aModulePopUp.Caption = "mod " & VBComp.Name 
         Case vbext_ct_Document 
            If VBComp.Name = "ThisWorkbook" Then 
               aModulePopUp.Caption = VBComp.Name 
            Else 
               aModulePopUp.Caption = "Sheet " & _
                                      VBComp.Properties("Name").Value 
            End If 
         Case vbext_ct_MSForm 
            aModulePopUp.Caption = "frm " & VBComp.Name 
         Case vbext_ct_ClassModule 
            aModulePopUp.Caption = "cls " & VBComp.Name 
         End Select 
         addRoutinesToPopup aModulePopUp.CommandBar, VBComp 
      End If 
   Next VBComp 
End Sub 
 
Private Sub addRoutinesToPopup(moduleCmdBar As CommandBar, _
                               VBComp As VBIDE.VBComponent) 
 
   Dim ProcKind As VBIDE.vbext_ProcKind 
   Dim LineNum As Long 
   Dim ProcName As String 
 
   Dim aButton As CommandBarButton 
 
   With VBComp.CodeModule 
      LineNum = .CountOfDeclarationLines + 1 
      Do Until LineNum >= .CountOfLines 
         ProcName = .ProcOfLine(LineNum, ProcKind) 
         Set aButton = moduleCmdBar.Controls.Add(msoControlButton) 
         aButton.Caption = ProcName   ' the sub or Function name 
         Select Case TypeOfProc(.Lines(.ProcBodyLine(ProcName, ProcKind), 1)) 
         Case "Sub" 
            aButton.FaceId = 186 
         Case "Sub with optional Param." 
            aButton.FaceId = 156 
         Case "Sub with Param." 
            aButton.FaceId = 187 
         Case "Function" 
            aButton.FaceId = 385 
         Case Else 
            aButton.FaceId = 190 
         End Select 
         aButton.Parameter = TheMacroFile   'the file name containing the macros 
         aButton.Tag = VBComp.Name   ' the code module name 
         aButton.OnAction = "StartOrGotoSpecificMacro"   '"GotoProcedure" 
         LineNum = LineNum + .ProcCountLines(ProcName, ProcKind) + 1 
      Loop 
   End With 
End Sub 
 
Function TypeOfProc(procTitleLine As String) As String 
   If InStr(1, procTitleLine, "Sub", vbTextCompare) Then 
      If InStr(1, procTitleLine, "()", vbTextCompare) Then 
         TypeOfProc = "Sub" 
      ElseIf InStr(1, procTitleLine, "(Optional", vbTextCompare) Then 
         TypeOfProc = "Sub with optional Param." 
      Else 
         TypeOfProc = "Sub with Param." 
      End If 
      Exit Function 
   ElseIf InStr(1, procTitleLine, "Function", vbTextCompare) Then 
      TypeOfProc = "Function" 
      Exit Function 
   Else 
      TypeOfProc = "unknown" 
   End If 
End Function 
 
'------------------------------------------------------------------------------ 
' Total Code Lines In A Component 
' 
Public Function TotalCodeLinesInVBComponent(VBComp As VBIDE.VBComponent) As Long 
' original from Chip Pearson 
' modified 
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
' This returns the total number of code lines (excluding blank lines and 
' comment lines) in the VBComponent referenced by VBComp. Returns -1 
' if the VBProject is locked. 
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
   Dim N As Long 
   Dim s As String 
   Dim LineCount As Long 
   If VBComp.Collection.Parent.Protection = vbext_pp_locked Then 
      TotalCodeLinesInVBComponent = -1 
      MsgBox "VBA protection discovered" 
      Exit Function 
   End If 
   On Error Resume Next 
   With VBComp.CodeModule 
      For N = 1 To .CountOfLines 
         s = .Lines(N, 1) 
         If Trim(s) = vbNullString Then 
            ' blank line, skip it 
         ElseIf Left(Trim(s), 1) = "'" Then 
            ' comment line, skip it 
         Else 
            LineCount = LineCount + 1 
         End If 
      Next N 
   End With 
   TotalCodeLinesInVBComponent = LineCount 
End Function 
 
Private Sub SortCmdBar(WindowCmdBar As CommandBar) 
   Dim CmdCaptions() As Variant 
   Dim i As Integer 
   Dim j As Variant 
   Dim s As String 
 
   i = WindowCmdBar.Controls.Count 
   Redim CmdCaptions(i) 
   For i = 1 To WindowCmdBar.Controls.Count 
      CmdCaptions(i) = WindowCmdBar.Controls(i).Caption 
   Next i 
   BubbleSort CmdCaptions 
   For i = WindowCmdBar.Controls.Count To 1 Step -1 
      '1 To WindowCmdBar.Controls.Count 
      j = WindowCmdBar.Controls(CmdCaptions(i)).Index 
      WindowCmdBar.Controls(j).Move Before:=1 
   Next i 
   s = Left(WindowCmdBar.Controls(1).Caption, 4) 
   For i = 2 To WindowCmdBar.Controls.Count 
      If Left(WindowCmdBar.Controls(i).Caption, 4) <> s Then 
         WindowCmdBar.Controls(i).BeginGroup = True 
         s = Left(WindowCmdBar.Controls(i).Caption, 4) 
      End If 
   Next i 
End Sub 
Sub BubbleSort(MyArray() As Variant) 
   Dim First As Integer 
   Dim Last As Integer 
   Dim i As Integer 
   Dim j As Integer 
   Dim Temp As String 
 
   First = Lbound(MyArray) 
   Last = Ubound(MyArray) 
   For i = First To Last - 1 
      For j = i + 1 To Last 
         If MyArray(i) > MyArray(j) Then 
            Temp = MyArray(j) 
            MyArray(j) = MyArray(i) 
            MyArray(i) = Temp 
         End If 
      Next j 
   Next i 
End Sub 
 
'-------------------------------------------------------------------------- 
' Procedure : StartOrGotoSpecificMacro 
' Author    : Hartmut Gruenhagen 
' Date      : 06-Feb-14 
' Purpose   : Starts a Macro when the menu is clicked. 
'             or opens the VBA editor when the "Ctrl" is pressed while 
'             clicking the menu. Subs with parameters, Functions, etc. 
'             will always be opened in the VBA editor. 
'-------------------------------------------------------------------------- 
' 
Sub StartOrGotoSpecificMacro() 
 
   Dim lStartLine As Long 
   Dim cmdBtn As CommandBarButton 
   Dim myAppl As Object 
 
   On Error Resume Next 
   Set cmdBtn = Application.CommandBars.ActionControl 
   If cmdBtn Is Nothing Then Exit Sub 
   If Application.Name = "Microsoft Excel" Then 
      Set myAppl = Application.Workbooks(cmdBtn.Parameter) 
   ElseIf Application.Name = "Microsoft PowerPoint" Then 
      Set myAppl = Application.Presentations(cmdBtn.Parameter) 
   ElseIf Application.Name = "Microsoft Word" Then 
      Set myAppl = Application.Documents(cmdBtn.Parameter) 
   ElseIf Application.Name = "Microsoft Access" Then 
      Set myAppl = Application.VBE.ActiveVBProject 
   End If 
   If Application.Name <> "Microsoft Access" Then 
      With myAppl.VBProject.VBComponents(cmdBtn.Tag).CodeModule 
         If Key_pressed(vbKeyControl) Then 
            lStartLine = .ProcBodyLine(cmdBtn.Caption, 0) 
            .CodePane.SetSelection lStartLine, 1, lStartLine, 1 
            .CodePane.Show 
         Else 
            Select Case TypeOfProc(.Lines(.ProcBodyLine(cmdBtn.Caption, _
                                                        0), 1)) 
            Case "Sub", "Sub with optional Param." 
Debug.Print "starting: " & "'" & cmdBtn.Parameter & "'!" & cmdBtn.Tag & _
            "." & cmdBtn.Caption 
               Application.Run "'" & cmdBtn.Parameter & "'!" & _
                               cmdBtn.Tag & "." & cmdBtn.Caption 
            Case Else 
               lStartLine = .ProcBodyLine(cmdBtn.Caption, 0) 
               .CodePane.SetSelection lStartLine, 1, lStartLine, 1 
               .CodePane.Show 
            End Select 
         End If 
      End With 
   Else 
      With myAppl.VBComponents(cmdBtn.Tag).CodeModule 
         If Key_pressed(vbKeyControl) Then 
            lStartLine = .ProcBodyLine(cmdBtn.Caption, 0) 
            .CodePane.SetSelection lStartLine, 1, lStartLine, 1 
            .CodePane.Show 
         Else 
            Select Case TypeOfProc(.Lines(.ProcBodyLine(cmdBtn.Caption, 0), 1)) 
            Case "Sub", "Sub with optional Param." 
Debug.Print "starting: " & "'" & cmdBtn.Parameter & "'!" & cmdBtn.Tag & _
            "." & cmdBtn.Caption 
               Application.Run "'" & cmdBtn.Parameter & "'!" & cmdBtn.Tag & _
                               "." & cmdBtn.Caption 
            Case Else 
               lStartLine = .ProcBodyLine(cmdBtn.Caption, 0) 
               .CodePane.SetSelection lStartLine, 1, lStartLine, 1 
               .CodePane.Show 
            End Select 
         End If 
      End With 
   End If 
End Sub 
 
Function Key_pressed(key_to_check As Long) As Boolean 
   If GetAsyncKeyState(key_to_check) And &H8000 Then 
      Key_pressed = True 
   Else 
      Key_pressed = False 
   End If 
End Function 
 

Sub replace_entry_with_link(ByRef target As Range)
    Dim c As Range
    For Each c In target
        With Application.Range(Mid(c.Validation.Formula1, 2)).Find(c.Value)
            c.Formula = "=" & .Worksheet.Name & "!" & .Address
        End With
    Next c
End Sub

Code eingefügt mit VBA in HTML 2.3 ∞

List all references to other sheets

Modul Modul1

Option Explicit 

Sub List_all_references_to_other_Sheets() 

Dim ws As Worksheet
Set ws = ActiveSheet 

Dim wt As Worksheet
Set wt = Worksheets.Add 

On Error Resume Next ' just in case the “planned” sheet name already exists 

wt.Name = ws.Name & “ - links” 

On Error GoTo 0 

With wt 

.Range("A1").Formula = "Cell" 

.Range("B1").Formula = "Formula" 

.Range("A1:B1").Font.Bold = True 

End With 

Dim t As Range 

Set t = wt.[A2] 

Dim c As Range 

For Each c In ws.UsedRange 

If InStr(1, c.Formula, “‘”) Then 

t.Formula = c.Address 

t(1, 2) = “‘” & c.Formula 

Set t = t(2, 1) 

End If 

Next c 

wt.Columns("A:B").EntireColumn.AutoFit 

wt.Range("A1").Select 

End Sub

Code eingefügt mit VBA in HTML 2.3