copy code across to new sheet

richey

New Member
Joined
Feb 17, 2002
Messages
7
Hi
I have some code running on the BeforeDoubleClick of a Worksheet
I have some code which adds a new sheet etc, which is great but it doesn't copy the code for BeforeDoubleClick across to the new sheet?

any help much appreciated
 

Excel Facts

Formula for Yesterday
Name Manager, New Name. Yesterday =TODAY()-1. OK. Then, use =YESTERDAY in any cell. Tomorrow could be =TODAY()+1.
On 2002-04-25 01:56, richey wrote:
Hi
I have some code running on the BeforeDoubleClick of a Worksheet
I have some code which adds a new sheet etc, which is great but it doesn't copy the code for BeforeDoubleClick across to the new sheet?

any help much appreciated

Hi Richie
This is how I have done similar in the past.
See if you can adapt it. The key is in your
Double click code...you will have o hard
code this in using my example.

<pre/>
Option Explicit

Sub CreateSheet_DblCk_Event()
Add_Sheet
Add_DblClick_To_CodeMod
End Sub

Sub Add_Sheet()

On Error Resume Next
Tryagain:
Sheets.Add
If Err <> 0 Then
Application.DisplayAlerts = False
ActiveSheet.Delete
GoTo Tryagain
End If
On Error GoTo 0

Application.EnableEvents = True

End Sub

Sub Add_DblClick_To_CodeMod()
Dim ModEvent As CodeModule 'Module to Modified
Dim LineNum As Long 'Line number in module
Dim SubName As String 'Event to change as text
Dim Proc As String 'Procedure string
Dim EndS As String 'End sub string
Dim Ap As String 'Apostrophe
Dim Tabs As String 'Tab
Dim LF As String 'Line feed or carriage return
Dim newShCodeNm 'Newsheet code name
Dim oWks As Worksheet

Set oWks = ThisWorkbook.ActiveSheet
Ap = Chr(34)
Tabs = Chr(9)
LF = Chr(13)
EndS = "End Sub"

'// Get Code name of sheet
Set newShCodeNm = oWks.Parent.VBProject.VBComponents(oWks.CodeName).Properties("_CodeName")

'// Your Event Procedure OR SubRoutine
SubName = "Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range," _
& "Cancel As Boolean)" & LF

'// Your Procedure
Proc = "If Range(" & Ap & "A1" & Ap & " ) = 1 Then" & LF
Proc = Proc & Tabs & "MsgBox " & Ap & "Testing number =" & Ap & _
"& Range(" & Ap & "A1" & Ap & ")" & LF
Proc = Proc & "End If" & LF

'// Use ThisWorkbook so that it cannot Act on another workbook
Set ModEvent = ThisWorkbook.VBProject.VBComponents(newShCodeNm).CodeModule

With ModEvent
LineNum = .CountOfLines + 1
.InsertLines LineNum, SubName & Proc & EndS
End With

End Sub

</pre>
 
Upvote 0

Forum statistics

Threads
1,213,549
Messages
6,114,264
Members
448,558
Latest member
aivin

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top