PDA

View Full Version : Solved: Adding code to worksheet module



mdmackillop
09-09-2004, 11:51 AM
The attachment is based on DRJ's extremely useful "Find all words in Excel" KB submission. For my purpose, I want to use it in a single workbook. The code as modified now adds a worksheet called "FindWord" to the active workbook, containing the information links etc. What I want to do is to add some code to this sheet, which will do another search when the search term in cell B1 is changed.
Problem is, I don't know much about adding VBComponents and referencing them:bawl
The attachment should run once, to show what should happen, but I'm having to reference FindWord as Sheet4, which may not always be true.
Secondly, I really want to put the search module into Personal.xls, so that I can call it from any spreadsheet. The further problem there is the "ActiveVBProject" (I think) which wants to write the code to a module in Personal.xls.
Any assistance greatly appreciated!
Regards,
MD

Sub ExportCodeMod()
Dim strCode As String
'Code to be written to "FindWord"
'Private Sub Worksheet_Change(ByVal Target As Range)
'If Target.address = "$B$1" Then
'Application.Run ("Personal.xls!Search.FindAll"), Target.Text, "False"
'Cells(1, 2).Select
'End if
'End Sub

'Line to be inserted instead of 3rd line below to run from Personal.xls
'& "Application.Run (" & Chr(34) & "Personal.xls!Search.FindAll" & Chr(34) & "), Target.Text, " & Chr(34) & "False" & Chr(34) & vbCr _

strCode = "Private Sub Worksheet_Change(ByVal Target As Range)" & vbCr _
& "If Target.Address = " & Chr(34) & "$B$1" & Chr(34) & " Then" & vbCr _
& "FindAll Target.Text, " & Chr(34) & "False" & Chr(34) & vbCr _
& "Cells(1,2).Select" & vbCr _
& "End if" & vbCr _
& "End Sub"

Application.VBE.ActiveVBProject.VBComponents.Item("Sheet4") _
.CodeModule.AddFromString (strCode)
End Sub

CBrine
09-09-2004, 12:20 PM
This is the basic code for doing what you want. Make your new workbook the activeworkbook and run this code. The code that is added in in the form of one long string. That's why I have a line of code then & CHR(13) & Next line of code. Let me know if you have any problem implementing it.

NOTE: Make sure you save prior to running any of this code. If you get something that the vba editor would choke on, then Excel will crash(At least in 97). You will also need to set a reference to VBA Extensibility lib.(Or change the code to late binding)

HTH

Dim WB1 As Workbook
Dim WS1 As Worksheet
Dim MD As VBComponent
Dim PD As CodeModule
Dim LineNumber As Long
Dim CmdBut As msforms.CommandButton

Set WB1 = ActiveWorkbook
Set WS1 = ActiveSheet

'Sets up a new module based on MD

Set MD = WB1.VBProject.VBComponents.Add(vbext_ct_StdModule)
MD.Name = "Module1"
Application.Visible = True

'Add Code to Module
Set PD = WB1.VBProject.VBComponents(MD.Name).CodeModule
With PD
LineNumber = .CountOfLines + 1
.InsertLines LineNumber, _
"Public BarNames(30) as String" & Chr(13) & "Public Counter As Integer" & Chr(13) & _

End With

mdmackillop
09-09-2004, 12:53 PM
Hi CBrine,
My code creates a worksheet which appears in the Project Explorer as
Sheet4(FindWord) or Sheet5(FindWord) etc., depending upon the workbook.
The code I want to run is triggered by a WorkSheet change, so I have to get my code into that Worksheet module, a standard module won't work.
I'm fiddling with code such as

Application.WB1.VBProject.VBComponents.Item("FindWord") _
.CodeModule.AddFromString (strCode)

but I'm not sure if I have to find the correct sheet number for FindWord, and insert that instead.
MD

CBrine
09-09-2004, 01:05 PM
This should work for you.

Dim WB1 As Workbook
Dim WS1 As Worksheet
Dim MD As VBComponent
Dim PD As CodeModule
Dim LineNumber As Long


Set PD = WB1.VBProject.VBComponents("ThisWorkbook").CodeModule
With PD
LineNumber = .CountOfLines + 1
.InsertLines LineNumber, _
"Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)" & Chr(13) & "application.cutcopymode =false" & Chr(13) & "End Sub" & chr(13) & _ 'Your next event title would go here if you were doing more then one event.

mdmackillop
09-09-2004, 01:09 PM
Hi CBrine,
Based on your components, the following works

WB1.VBProject.VBComponents.Item("sheet4").CodeModule.AddFromString (strCode)
so I just need to find determine the link between the Sheet# and the Name. Project Explorer shows two name values for a Sheet module
MD

CBrine
09-09-2004, 01:09 PM
mdmackillop,
Sorry that last post was for the workbook event's. For worksheet events your should be able to just change this
Set WS1 = ActiveSheet
to this
Set ws1 = sheets("FindWord")
and it should cycle down by itself.

CBrine
09-09-2004, 01:26 PM
Md,
I remember what you are talking about now. I remember dealing with on something as well. The module name and worksheet name don't need to match. I did come up with a solution to this, but I can't remember exactly what I did. Let me check in some of my sample code to see if I can find it.

Anne Troy
09-09-2004, 01:37 PM
Sample code? SAMPLE CODE???
And it's not in our KB??
Hee hee....

Somehow, CBrine, your post threw an error into the forum database. Weird.

CBrine
09-09-2004, 02:16 PM
Yeah, I saw that. I'm using slim browser as my browser, don't know if that might be what's causing the trouble. I think I might have trojan lurking around on my system as well, so you never know what it's doing.

mdmackillop
09-09-2004, 02:17 PM
Hi CBrine,
Getting closer. It works if I step through it, but not when it runs :confused:
MD


FWord = WB1.Sheets("FindWord").CodeName
WB1.VBProject.VBComponents.Item(FWord).CodeModule.AddFromString (strCode)

mdmackillop
09-09-2004, 02:54 PM
It seems to come down to this. In a workbook, if I rename a sheet manually, ExportCode will run. If I add a sheet using MakeSheet, it will not. (Excel 2000)


Sub MakeSheet()
On Error Resume Next
Sheets("FindWord").Select
If Err = 9 Then
Sheets.Add
ActiveSheet.name = "FindWord"
End If
End Sub


Sub ExportCode()
Dim WB1 As Workbook
Dim strCode As String
Dim FWord As String

Set WB1 = ActiveWorkbook
strCode = "Private Sub Worksheet_Change(ByVal Target As Range)" & vbCr _
& "If Target.Address = " & Chr(34) & "$B$1" & Chr(34) & " Then" & vbCr _
& vbTab & "Application.Run (" & Chr(34) & "Personal.xls!Search.FindAll" & Chr(34) & "), Target.Text, " & Chr(34) & "False" & Chr(34) & vbCr _
& vbTab & "Cells(1,2).Select" & vbCr _
& "End if" & vbCr _
& "End Sub"
FWord = WB1.Sheets("FindWord").CodeName
MsgBox FWord
WB1.VBProject.VBComponents.Item(FWord).CodeModule.AddFromString (strCode)
End Sub

mdmackillop
09-10-2004, 05:26 PM
See http://www.vbaexpress.com/forum/showthread.php?t=931 for a solution.