I have this code:
For a = 1 To 5
strFoglio = "SheetName" & a
Sheets.Add
ActiveSheet.Name = strFoglio
ActiveSheet.Move after:=Sheets(Sheets.Count)
Next a
Is there a way to write code on these brand new sheets for example:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim myRange As Range
End sub
Naturally, I'd like to do directly in the For...Next loop and not manually.
The code below will run your For loop, create 5 sheets, and per sheet will call a Sub CodeCopy which will copy the code lines from a Module (in this example the code in "Sheet1") into the new created sheet.
Code
Option Explicit
Sub CreateSheets()
Dim a As Long
For a = 1 To 5
Sheets.Add
ActiveSheet.Name = "SheetName" & a
ActiveSheet.Move after:=Sheets(Sheets.Count)
Call CodeCopy(ActiveSheet.Name)
Next a
End Sub
' **********
Sub CodeCopy(DestShtStr As String)
' Macro to copy the macro module from sheet1 to a new Sheet
' Name of new sheet is passed to the Sub as a String
' Must install "Microsoft Visual Basic for Applications Extensibility library"
' from Tools > References.
Dim i As Integer
Dim SrcCmod As VBIDE.CodeModule
Dim DstCmod As VBIDE.CodeModule
' set source code module to code inside "Sheet1"
Set SrcCmod = ActiveWorkbook.VBProject.VBComponents(ActiveWorkbook.Worksheets("Sheet1").CodeName).CodeModule
Set DstCmod = ActiveWorkbook.VBProject.VBComponents(ActiveWorkbook.Worksheets(DestShtStr).CodeName).CodeModule
' copies all code line inside "Sheet1"
' can be modified to a constant number of code lines
For i = 1 To SrcCmod.CountOfLines
DstCmod.InsertLines i, SrcCmod.Lines(i, 1)
Next i
End Sub
Code in "Sheet1" that will be copied to all new created sheets is:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim myRange As Range
End Sub
Instructions
In order for this code to work, you need to allow the following 2 things:
Go to Tools >> References, and add a reference to "Microsoft Visual Basic for Applications Extensibility" library (screen-shot below)
In Excel Main menu, go to Developer Menu, then select Macro Security, the click V to allow "Trust access to the VBA project object model" (screen-shot below)
If i understand well, you want to create code directly on the new sheets created with your initial code.
So i would do like this :
Code(1) = Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Code(2) = Dim myRange As Range
Code(3) = '....
For i = 1 To 3
Wb.VBProject.VBComponents("SheetName & a").CodeModule.InsertLines i, Code(i)
Next i
(Just put it in loop)
Related
I am trying to write VBA code so that whenever I open any file in excel, it automatically goes to Cell A1 in all sheets (no matter what cells were selected when it was last saved). I found something online that suggested putting the following code in my Personal .xlsb project:
Sub kTest()
Dim i As Long, s() As String, a As String, n As Long
With ActiveWorkbook
For i = 1 To .Worksheets.Count
a = a & .Worksheets(i).Name
n = n + 1
ReDim Preserve s(1 To n)
s(n) = .Worksheets(i).Name
If Len(a) > 224 Then
.Worksheets(s).Select
.Worksheets(s(1)).Activate
[a1].Select
n = 0: a = "": Erase s
End If
Next
If Len(a) Then
.Worksheets(s).Select
.Worksheets(s(1)).Activate
[a1].Select
End If
Application.Goto .Worksheets(1).Range("a1")
End With
End Sub
But nothing happens when I open a file. Please help!
You cannot go to Cell A1 in every sheet. But if you would like to go to Cell A1 of a single sheet you could do the following.
Create a class ExcelEvents with the following code
Option Explicit
Private WithEvents App As Application
Private Sub App_WorkbookOpen(ByVal Wb As Workbook)
App.Goto Wb.Worksheets(1).Range("A1")
End Sub
Private Sub Class_Initialize()
Set App = Application
End Sub
And in ThisWorkbook add
Option Explicit
Private xlApp As ExcelEvents
Private Sub Workbook_Open()
Set xlApp = New ExcelEvents
End Sub
Save the workbook, re-open it and the code in the workbook_open event will run and that means as soon as you open another workbook the code will goto cell A1 of sheet 1
EDIT If you really mean to select A1 in every single sheet you could change the code as follows
Private Sub App_WorkbookOpen(ByVal Wb As Workbook)
Dim sh As Worksheet
App.ScreenUpdating = False
For Each sh In Wb.Worksheets
sh.Select
sh.Range("A1").Select
Next
App.Goto Wb.Worksheets(1).Range("A1")
App.ScreenUpdating = True
End Sub
A simple solution:
For Each Sheet In ActiveWorkbook.Worksheets
Sheet.Select
Range("A1").Select
Next
Using MicScoPau's loop through the worksheets
Place the following code in the ThisWorkbook module of Personal.xlsb:
You'll have to reopen excel for this to work the first time.
If your Personal.xlsb is hidden, then you will have some issues with the each sheet in activeworkbook.
Private WithEvents app As Application
Private Sub app_WorkbookOpen(ByVal Wb As Workbook)
For Each Sheet In ActiveWorkbook.Worksheets
Sheet.Select
Range("A1").Select
Next
End Sub
Private Sub Workbook_Open()
Set app = Application
End Sub
Using Excel 2007, I understand that I can create worksheet_change event on the worksheet it's created.
But how do I assign a global sub change events to a newly created worksheet?
e.g.
Public Sub DataChange(ByVal Target As Range)
' this will check and see if the user or operator has change the column field
' if they fill in "X", mark the whole row to red color
' otherwise leave it black
Dim KeyCells As Range
Dim LastRow As Long
LastRow = Cells(Rows.Count, 1).END(xlUp).Row
Set KeyCells = Range("L2:L" & LastRow)
If Not Application.Intersect(KeyCells, Range(Target.Address)) _
Is Nothing Then
If Target.Value = "X" Or Target.Value = "x" Then
Target.EntireRow.Font.color = vbRed
Else
Target.EntireRow.Font.color = vbBlack
End If
End If
End Sub
Then in a separate sub procedure in Module1...
Public Sub CreateWorkSheet()
Dim ws As Worksheet
Set ws = Sheets.Add
ws.Name = "Test1"
' Here where I want to set the event but I do not know the syntax
' ws.OnChange = DataChange
Debug.Print "Done"
End Sub
I'm used to assign events on the fly when creating controls (C#/WPF/Pascal), so I figured there would be one in Excel world. Any advice or help would be greatly appreciated.
As mentioned by Jeeped, probably the easiest way would be to copy the sheet that already had the Private Sub Worksheet_Change code behind it, but there is also another way, if you place the following code under ThisWorkbook, whenever a new sheet is created it will add the desired code behind it:
Private Sub Workbook_NewSheet(ByVal Sh As Object)
Dim NewSheet As Worksheet
Set NewSheet = Sheets(ActiveSheet.Name)
Code = "Private Sub Worksheet_Change(ByVal Target As Range)" & vbCrLf
Code = Code & "MsgBox ""your code here""" & vbCrLf
Code = Code & "End Sub"
With ThisWorkbook.VBProject.VBComponents(NewSheet.Name).CodeModule
NextLine = .CountOfLines + 1
.InsertLines NextLine, Code
End With
End Sub
The drawback here is that the Trust Settings for Macros would need to be changed by clicking on the Trust access to the VBA project object model:
EDIT:
You could also copy code from one worksheet to another using a similar method:
Sub test()
Dim CodeCopy As VBIDE.CodeModule
Dim CodePaste As VBIDE.CodeModule
Dim numLines As Long
Set CodeCopy = ActiveWorkbook.VBProject.VBComponents("Sheet1").CodeModule
Set CodePaste = ActiveWorkbook.VBProject.VBComponents("Sheet2").CodeModule
numLines = CodeCopy.CountOfLines
'Use this line to erase all code that might already be in sheet2
'If CodePaste.CountOfLines > 1 Then CodePaste.DeleteLines 1, CodePaste.CountOfLines
CodePaste.AddFromString CodeCopy.Lines(1, numLines)
End Sub
I'd go for the last #Jeeped's suggestion
place this code in ThisWorkbook code pane
Option Explicit
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
DataChange Target ' this sub will be called at any change of any worksheet passing the chenged range
End Sub
then place this in the same code pane or in any other Module
Public Sub DataChange(ByVal Target As Range)
' this will check and see if the user or operator has change the column field
' if they fill in "X", mark the whole row to red color
' otherwise leave it black
Dim KeyCells As Range
Set KeyCells = Range("L2:L" & Cells(Rows.Count, 1).End(xlUp).Row)
If Not Application.Intersect(KeyCells, Target) Is Nothing Then Target.EntireRow.Font.color = IIf(UCase(Target.Value2) = "X", vbRed, vbBlack)
End Sub
How to put the programmatically generated workbook an event code similar to below:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim nextTarget As Range
Set nextTarget = Range(Selection.Address) 'store the next range the user selects
Target.Columns.Select 'autofit requires columns to be selected
Target.Columns.AutoFit
nextTarget.Select
End Sub
Use this to add a workbook and place a worksheet change event into the Sheet1 module.
Sub AddSht_AddCode()
Dim wb As Workbook
Dim xPro As VBIDE.VBProject
Dim xCom As VBIDE.VBComponent
Dim xMod As VBIDE.CodeModule
Dim xLine As Long
Set wb = Workbooks.Add
With wb
Set xPro = .VBProject
Set xCom = xPro.VBComponents("Sheet1")
Set xMod = xCom.CodeModule
With xMod
xLine = .CreateEventProc("Change", "Worksheet")
xLine = xLine + 1
.InsertLines xLine, " Cells.Columns.AutoFit"
End With
End With
End Sub
When you 1st run the code you may get an error.
Hit the Stop Icon and select the tools menu and "References"
Then find "Microsoft Visual Basic for Applications Extensibility 5.3 library" and check it.
Run the code again and it should work.
I have a userform that fields the user's input to take certain actions within a workbook, one of the actions is inserting a new tab in the workbook and having the user input the new sheet's name within an input box. I want to be able to then reference this new sheet (but I won't know what someone else might name it) and to paste a chart object within the newly created sheet.
So far the adding sheet code is working fine, but any of my attempts to paste the chart range are not working. My current code for adding the worksheet is:
Private Sub MyChart_Click()
Dim Answer As String
Dim sht_name As Variant
On Error Resume Next
If Me.OptionButton2.Value = True Then
Unload Me
sht_name = InputBox("Please enter value")
If sht_name <> "" Then
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = sht_name
Else
Exit Sub
End Sub
My chart lives in another worksheet ("Sheet2") and I am trying to just copy it into the newly created sheet whenever the user selects this OptionButton2 in the Userform... Any help is appreciated.
When you use the Worksheets.Add method, that sheet automatically is activated. To test this you can run this small portion of code:
Option Explicit
Private Sub SheetReference()
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Test"
Debug.Print ActiveSheet.Name
End Sub
And the output you would see is
Test
So in your case, you could declare a worksheet variable and then set the reference after you call the add method. Something like this:
Option Explicit
Private Sub MyChart_Click()
Dim Answer As String
Dim sht_name As Variant
Dim ws As Worksheet
On Error Resume Next
If Me.OptionButton2.Value = True Then
Unload Me
sht_name = InputBox("Please enter value")
If sht_name <> "" Then
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = sht_name
Set ws = ActiveSheet
With ws
'Do whatever you need to do on the worksheet
End With
Else
Exit Sub
End If
End Sub
Can someone please help me with a macro? I want to move and/or copy a few selected sheets (hidden & visible) to a new workbook, but since I have a few workbooks open at a time, I want to be able to select worksheets in all open workbooks from like a drop down menu and move and/or copy to a new workbook. I want to move some and copy some worksheets so will need both options in selection box.
Please help as I have cracked my head on it and got nowhere.
I have tried the below:
Sub CopySheet()
Dim i As Integer, x As Integer
Dim shtname As String
'i = Application.InputBox("Copy how many times?", "Copy sheet", Type:=1)
'For x = 0 To i - 1
ActiveSheet.Copy After:=Sheets(Sheets.Count)
shtname = InputBox("What's the new sheet name?", "Sheet name?")
ActiveSheet.Name = shtname
'Next x
End Sub
But this will mean I have to type every sheet name every time.
Adam: While I try to run your code, it gives me an error - variable not specified in row Private Sub btnSubmit_Click()
How do I overcome it?
I still can't get it right Adam. I am very new to Macros and I may be doing something wrong with interpreting your instructions. Can you please suggest something like all included in one and run?
Where exactly in the original codes do I need to paste this code
Private Sub btnSubmit_Click()
End Sub
This code should get you going. It is all of the code-behind for a UserForm with two listboxes, a checkbox, and a command button for submit. The dropdowns are populated automatically depending on what workbooks are open and what worksheets these workbooks contain. It also has the option to move or copy the selected worksheet. However, you still will need to add the functionality for copying the sheet multiple times, but that will just be a loop, and shouldn't be too difficult.
'All of this code goes in the section which appears when you right click
'the form and select "View Code"
Option Explicit
Public Sub OpenWorksheetSelect()
Dim WorksheetSelector As New frmWorksheetSelect
WorksheetSelector.Show
End Sub
Private Sub lstWorkbooks_Change()
FillWorksheetList
End Sub
Private Sub UserForm_Initialize()
FillWorkbookList
End Sub
Sub FillWorkbookList()
'Add each workbook to the drop down
Dim CurrentWorkbook As Workbook
For Each CurrentWorkbook In Workbooks
lstWorkbooks.AddItem CurrentWorkbook.Name
Next CurrentWorkbook
End Sub
Sub FillWorksheetList()
Dim WorkbookName As String
WorkbookName = lstWorkbooks.Text
If Len(WorkbookName) > 0 Then
Dim CurrentWorksheet As Worksheet
For Each CurrentWorksheet In Workbooks(WorkbookName).Sheets
lstWorksheets.AddItem CurrentWorksheet.Name
Next CurrentWorksheet
End If
End Sub
Private Sub btnSubmit_Click()
Dim WorkbookName As String, WorksheetName As String
WorkbookName = lstWorkbooks.Text
WorksheetName = lstWorksheets.Text
If Len(WorkbookName) > 0 And Len(WorksheetName) > 0 Then
If chkCopy = True Then
Workbooks(WorkbookName).Sheets(WorksheetName).Copy Before:=Workbooks.Add.Sheets(1)
Else
Workbooks(WorkbookName).Sheets(WorksheetName).Move Before:=Workbooks.Add.Sheets(1)
End If
End If
Unload Me
End Sub