Adding A Procedure To An Active Worksheet programmatically  (Requires amending)

Posted on 2011-05-06
Last Modified: 2012-05-11
Hi Experts,

I have an excel Toolbar addin, with various functions / macros which i like to add to when i find something i could use, either now or in the future.

Recently, i have had to go through a list of IP Addresses on a spreadsheet and run a continuous ping to them. (so i have several cmd boxes open at a time)

I figured it would be useful to have a script that would run a seperate ping for every cell on the worksheet that had an IP Address (so i have several cmd.exe's running at a time), and i managed to get one working.
I would like to stress at this point, that i need to have visible cmd boxes running. I have come across scripts that will do this silently but that is not what is required.

Anyway, I added the code i found on Google, to a Worksheet Module and it runs like a dream.
For every IP Address in every cell (that is optional), when it's clicked a dos box (cmd) pops up and starts a continuous ping.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim sPingcmd As String
    On Error GoTo ErrorTrap
'If you want to use a specified range use this one
    If Intersect(Target, Range("A1:A5")).Address = Target.Address Then
'If you want to do all cells with IP Addresses use this one.
'If Intersect(Target, UsedRange).Address = Target.Address Then
        sPingcmd = "ping -a -t " & Target.Value
        Call Shell("cmd /K" & sPingcmd, vbNormalFocus)
    End If
End Sub

Open in new window

Then i thought i would go one better and try to add it to my Toolbar addin.
I realised that the code needed to run on a Worksheet of the Activebook, (not my Addin) so i needed to copy the module directly onto the Active Workbook Worksheet, so with the help of Chip Pearson ( i came up with this .

    Sub AddProcedureToModule()
        Dim VBProj As VBIDE.VBProject
        Dim VBComp As VBIDE.VBComponent
        Dim CodeMod As VBIDE.CodeModule
        Dim LineNum As Long
        Const DQUOTE = """" ' one " character
        Dim strName As String
        Dim Target
        Set VBProj = ActiveWorkbook.VBProject

'Original Code left behind for now
'Set VBComp = VBProj.VBComponents("Module1")
'Set CodeMod = VBComp.CodeModule
'Ask for the Sheet name where the IP Addresses are located.
       strName = InputBox(Prompt:="What Sheet are you working on?.", _
          Title:="ENTER YOUR NAME", Default:="Your Name here")

 'With CodeMod

 With ActiveWorkbook.VBProject.VBComponents(strName).CodeModule
  LineNum = .CountOfLines + 10
 .InsertLines LineNum, "Private Sub Worksheet_SelectionChange(ByVal Target As Range)"
   LineNum = LineNum + 1
   .InsertLines LineNum, "Dim sPingcmd As String"
   LineNum = LineNum + 1
  .InsertLines LineNum, "On Error GoTo ErrorTrap"
   LineNum = LineNum + 1
  .InsertLines LineNum, "If Intersect(Target, UsedRange).Address = Target.Address Then"
   LineNum = LineNum + 1

, If i use the commented lines below it errors out.
'  .InsertLines LineNum, "sPingcmd = "ping -a -t " & Target.Value"
   .InsertLines LineNum, "sPingcmd = ping - a - t & Target.Value"
    LineNum = LineNum + 1
'  .InsertLines LineNum, "Call Shell("cmd /K" & sPingcmd, vbNormalFocus)"
   .InsertLines LineNum, "Call Shell(cmd /K & sPingcmd, vbNormalFocus)"
    LineNum = LineNum + 1

   .InsertLines LineNum, "End If"
    LineNum = LineNum + 1
   .InsertLines LineNum, "ErrorTrap:"
    LineNum = LineNum + 1

'Original Code left behind for now.
'   .InsertLines LineNum, "    MsgBox " & DQUOTE & "Hello World"
'    LineNum = LineNum + 1

   .InsertLines LineNum, "End Sub"
    End With
    End Sub

Open in new window

This code will add the Worksheet Ping procedure named Private Sub Worksheet_SelectionChange(ByVal Target As Range) to the Worksheet Module (Worksheet name supplied by User) of the Active Workbook..

However, there are two lines of code that are causing errors and causing it to stop working and it seems to be the "quotation marks" in the middle of the sentence, that is causing the issues...

These lines are the correct code on the Worksheet but don't work in my 'AddProcedureToModule" Sub.

.InsertLines LineNum, "sPingcmd = "ping -a -t " & Target.Value"
.InsertLines LineNum, "Call Shell("cmd /K" & sPingcmd, vbNormalFocus)"

For all intents and purposes, if i remove the quotation marks from the lines of code it copies it over to the Worksheet Module and the complete code is there, however of course the code doesn't work because i've removed necessary quotation marks.

(If i put the code like this is copies over but doesn't work)
  .InsertLines LineNum, "sPingcmd = ping - a - t & Target.Value"

Can anyone please help me amend my code so that i will work correctly with quotation marks...
I've tried adding quotation marks in places that i thought would help but sadly i got no where fast.

Many thanks for your time.

Question by:vestanpance_uk
    LVL 24

    Accepted Solution

    This is a complete guess, but maybe you have to double-up the quotes, e.g.:

    .InsertLines LineNum, "sPingcmd = ""ping -a -t"" & Target.Value"

    Author Closing Comment


    Fortune favours the brave.... :)

    Well done mate, that's quite possibly the only arrangement i didn't think to try...

    Thank you very much.

    Featured Post

    What Is Threat Intelligence?

    Threat intelligence is often discussed, but rarely understood. Starting with a precise definition, along with clear business goals, is essential.

    Join & Write a Comment

    Approximate matching with VLOOKUP and MATCH seems to me to be a greatly under-used technique, and one which is vital for getting good performance out of large lookups. Until recently I would always have advised using an exact match for simplicity an…
    Improved? Move/Copy Add-in Replacement - How to avoid the annoying, “A formula or sheet you want to move or copy contains the name XXX, which already exists on the destination worksheet.” David Miller (dlmille)  It was one of those days… I wa…
    The viewer will learn how to simulate a series of sales calls dependent on a single skill level and learn how to simulate a series of sales calls dependent on two skill levels. Simulating Independent Sales Calls: Enter .75 into cell C2 – “skill leve…
    This Micro Tutorial will demonstrate how to use longer labels with horizontal bar charts instead of the vertical column chart.

    729 members asked questions and received personalized solutions in the past 7 days.

    Join the community of 500,000 technology professionals and ask your questions.

    Join & Ask a Question

    Need Help in Real-Time?

    Connect with top rated Experts

    19 Experts available now in Live!

    Get 1:1 Help Now