Run Excel code from cell values

[SpaceActuary]

Originally Posted by DeepPurple

Can I put a piece of VBA code as text into a cell in the spreadsheet, and then have a VBA function look up the content of that cell and then execute the code found there?

Can you? Sure! Some sample code is listed below, just for giggles.
Should you? I wouldn't necessarily recommend it!

But first, a note on security:

http://support.microsoft.com/kb/282830

Your employer may not allow you to "Enable programmatic access to the Visual Basic Project" for security reasons. I do not condone bypassing any corporate guidelines, especially when they come to IT Security (even if the guidelines seem stupid).

And of course, use this code--and VBA Extensibility in general--at your own risk. You can do a lot of damage (or allow a lot of damage to be done to you)!


So, without further ado:

Spoiler:

Option Explicit

' NOTE: In Office 2002 or later, the TRUST ACCESS TO VISUAL BASIC PROJECT
' checkbox MUST be checked, or the code will not work.
' (This box is located in Tools|Options|Security
'  |Macro Security|Trusted Publishers)
' For more information, see: http://support.microsoft.com/kb/282830

' Declare the Globally-Unique IDentifier used to add a reference to 
' VBA Extensibility
Const VBE_GUID As String = "{0002E157-0000-0000-C000-000000000046}"
Const ADD_TO_MENUS As Boolean = False

Sub Auto_Open()
' Runs when the workbook opens    
    If ADD_TO_MENUS = True Then
        AddToMenus
    End If

End Sub

Sub AddToMenus()
' Adds the "ExecuteSelectedVBACode" macro to the cell right-click menu
    With Application.CommandBars("Cell").Controls
        .Item(1).BeginGroup = True
        With .Add(Type:=msoControlButton, Before:=1)
            .Caption = "Execute Selected VBA Code"
            .OnAction = "ExecuteSelectedVBACode"
            .FaceId = 2151
        End With
    End With

End Sub

Sub RemoveFromMenus()
' Removes the "ExecuteSelectedVBACode" macro from the cell right-click menu
    With Application.CommandBars("Cell").Controls
        On Error Resume Next
        .Item("Execute Selected VBA Code").Delete
        .Item(1).BeginGroup = False
        On Error GoTo 0
    End With
End Sub

Sub ExecuteSelectedVBACode()
' Executes the values of the selected cells as VBA code.
' NOTE: Adds reference to "Microsoft Visual Basic for Applications 
' Extensibility 5.*"
    ' Check to see that the selection is a range
    ' If a chart or shape is selected, the code won't work!
    If TypeName(Selection) = "Range" Then
        
        ' If a reference to VBA Extensibility doesn't exist,
        ' Add it!
        If ReferenceExists(VBE_GUID) = False Then
            AddReference VBE_GUID
        End If
                
        ' Call the macro that creates the procedure
        RangeToVBA _
            rng:=Selection, _
            WrapCodeInSub:=True, _
            Execute:=True
            
    End If

End Sub

Sub RangeToVBA(rng As Range, _
               Optional WrapCodeInSub As Boolean = False, _
               Optional Execute As Boolean = False)
' Takes the values of a passed range (one or more cells) and
' adds the values as code to a code module in the current workbook.
' NOTE: Requires reference to "Microsoft Visual Basic for Applications
' Extensibility 5.*"
    ' Declare constants for naming
    Const MODULE_NAME = "temp_module"
    Const PROC_NAME = "temp_procedure_"

    ' Declare variable for the code module
    Dim vbModule As VBComponent
    
    ' Declare variables for storing the
    ' code and procedure name
    Dim strCode As String
    Dim strProcedure As String
    
    ' Declare loop indexes
    Dim r As Long, c As Long
    
    ' Loop through the range and build the code
    ' Note - if the range contains multiple columns
    ' they are concatenated to the left-most cell in
    ' the row, without any delimiters between columns.
    For r = 1 To rng.Rows.Count
        For c = 1 To rng.Columns.Count
            strCode = strCode & rng.Cells(r, c)
        Next c
        strCode = strCode & vbCr
    Next r
    
    ' Check to see if the code passed should be "wrapped"
    ' in a procedure--open code statements must be!
    ' If the passed range already includes a sub/function header, then
    ' WrapCodeInSub should be passed as "False"
    If WrapCodeInSub = True Then
    
        ' Build a name for the procedure.
        ' To prevent "duplicate declaration in scope" errors,
        ' the current date/time is appended to the name.
        strProcedure = PROC_NAME & Format(Now(), "YYMMDD_HHNNSS")
        
        ' Wrap the code inside the auto-generated procedure.
        strCode = "Sub " & strProcedure & "()" & vbCr & strCode
        strCode = strCode & vbCr & "End Sub" & vbCr
       
    End If
       
    ' Get a reference to the code module
    On Error Resume Next
    Set vbModule = ThisWorkbook.VBProject.VBComponents(MODULE_NAME)
    Err.Clear
    On Error GoTo 0
    
    ' If the code module doesn't already exist, create it!
    If vbModule Is Nothing Then
        Set vbModule = ThisWorkbook.VBProject.VBComponents.Add _
                                                        (vbext_ct_StdModule)
        vbModule.Name = MODULE_NAME
    End If
    
    ' Add the code to the code module
    vbModule.CodeModule.AddFromString strCode

    ' If the code was open and the "execute" option is on,
    ' then execute the code that was just added to the module
    If WrapCodeInSub = True And Execute = True Then
        Application.Run strProcedure
    End If

End Sub

Function ReferenceExists(GUID As String) As Boolean
' Returns TRUE if a reference exists with the given GUID.
    Dim blnResult As Boolean
    Dim i As Long
    
    With ThisWorkbook.VBProject.References
        
        ' Loop through each reference in the current workbook
        For i = 1 To .Count
            ' Check to see if the GUID matches, and
            ' that the reference is not "broken".
            If .Item(i).GUID = GUID _
            And .Item(i).isbroken = False Then
                
                ' Found a missing, working reference
                blnResult = True
                Exit For
                
            End If
            
        Next i
        
    End With
    
    ' Return a result!
    ReferenceExists = blnResult
    
End Function

Sub AddReference(GUID As String)
' Macro purpose:  To add a reference to the project using the GUID for the
' reference library
' From: http://www.vbaexpress.com/kb/getarticle.php?kb_id=267
     
    Dim theRef As Variant, i As Long
          
     ' Set to continue in case of error
    On Error Resume Next
     
     ' Remove any missing references
    For i = ThisWorkbook.VBProject.References.Count To 1 Step -1
        Set theRef = ThisWorkbook.VBProject.References.Item(i)
        If theRef.isbroken = True Then
            ThisWorkbook.VBProject.References.Remove theRef
        End If
    Next i
     
     ' Clear any errors so that error trapping for
     ' GUID additions can be evaluated
    Err.Clear
     
     ' Add the reference
    ThisWorkbook.VBProject.References.AddFromGuid _
    GUID:=GUID, Major:=1, Minor:=0
     
     ' If an error was encountered, inform the user
    Select Case Err.Number
    Case Is = 32813
         ' Reference already in use.  No action necessary
    Case Is = vbNullString
         ' Reference added without issue    Case Else
         ' An unknown error was encountered, so alert the user
        MsgBox "A problem was encountered trying to" & vbNewLine _
        & "add or remove a reference in this file" & vbNewLine _ 
        & "Please check the references in your VBA project!", _ 
        vbCritical + vbOKOnly, "Error!"
    End Select
    On Error GoTo 0
End Sub

NOTE: I can't confirm compatibility with Excel 2007/2010.

[ThatGuy]

This only took him 10 minutes...

[Brad Gile]

I agree wholeheartedly with Space Actuary that this is NOT something you want to do! It may look cool, but what real value does it have and how does that value compare with possible security problems?

[ADoubleDot]

I can't think of any reason to do it. It looks terribly inefficient compared to "if"

[erosewater]

Somewhat unrelated, but along the lines of doing damage with VBA code: the Office object model gives you full access to the auto-complete library, which is universal across Office applications. So you can run code to add and/or change items in the auto-complete dictionary, without the user ever knowing. Very dangerous, but with the potential for great humor.