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

Posted on 2011-05-06
Medium Priority
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 (http://www.cpearson.com/excel/vbe.aspx) 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

StephenJR earned 1000 total points
ID: 35707483
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

ID: 35707512

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


Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This code takes an Excel list of URL’s and adds a header titled “URL List”. It then searches through all URL’s in column “A”, looking for duplicates. When a duplicate is found, it is moved to the top of the list. The duplicate URL’s are then highlig…
Freeze panes is an option within all variants of Excel to enable parts of a sheet to remain stationary when the cursor is in another part of the sheet. This is a very useful feature which is overlooked or under used.
This Micro Tutorial demonstrate the bugs in Microsoft Excel for Mac with Pivot Charts.
This Micro Tutorial will demonstrate the scrolling table in Microsoft Excel using the INDEX function.

840 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