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
Related
I have a module which is creating a sheet. It builds a worksheet with a series of tables.
I'd like to add a feature that uses the OnChange event for a cell to validate that the user entered a decimal. The following code does this If I can just inject into the new worksheet. That's the only thing I can't figure out.
Given 's' is the current Worksheet we've just created is there any way to inject the following code into the sheet code module of 's'?
Private Sub Worksheet_Change(ByVal Target As Range)
Const CELL_ADDRESS = "$R$4:$AQ$500"
If Not Application.Intersect(Target, Range(CELL_ADDRESS)) Is Nothing Then
If Not IsNumeric(Target.Value) Then
MsgBox "Please enter numbers only", vbCritical, "Invalid Entry"
Target.Value = vbNullString
End If
End If
End Sub
EDIT: Showing the chosen solution to the problem (chose Wedge's solution).
(Answer:) We will add a public function to the Addin which we will call from the Template and therefore all sheets created from the template.
Using a template and copying it will allow us to have custom code built into new sheets without having to change security settings.
Calling a public function allows us to make modifications to the sheet without putting the protected password in the sheet's code.
(Public Function Call inside the sheet)
Private Sub Worksheet_Change(ByVal Target As Range)
Dim wb As Workbook
Set wb = ActiveWorkbook
Dim ws As Worksheet
Set ws = wb.ActiveSheet
Application.Run "numberaddin.Validate_Input", wb, ws, Target
End Sub
(Public Function built into Addin which will be called by the sheet when a user modifies data.)
-- All this function does is make sure our cells store only numbers AS NUMBERS and with formatting. Any non-value text becomes a 0 in the cell. This works even if the user copy-pastes the data.
Public Function Validate_Input(wb As Workbook, ws As Worksheet, r As Range)
CELL_ADDRESS = Cells(1, 2).Value ''''we'll use the locked Cell B1 to specify the Validation Range
Dim rCell As Range
Dim eCell As Range
Dim numErr As Boolean
numErr = False
Set rCell = Range(CELL_ADDRESS)
If Not Application.Intersect(rCell, r) Is Nothing Then
ActiveSheet.Protect Password:="pw", UserInterfaceOnly:=True
Application.EnableEvents = False
For Each eCell In rCell.Cells
If Not eCell Is Nothing And eCell.Locked = False And Not Application.Intersect(eCell, r) Is Nothing Then
If IsNumeric(eCell.Value) = False Or IsEmpty(eCell.Value) = True Or eCell.Value <> eCell.Value + "0" Then
If Not IsNumeric(eCell.Value) Then
numErr = True
End If
eCell.Value = Val(eCell.Value)
End If
eCell.Interior.Color = RGB(255, 255, 153)
eCell.NumberFormat = "_(* #,##0_);_(* (#,##0);_(* "" - ""??_);_(#_)"
If eCell.Value > 1000000 Then
eCell.Columns.AutoFit
eCell.ColumnWidth = eCell.ColumnWidth * 1.2
End If
End If
Next eCell
Application.EnableEvents = True
ActiveSheet.Protect Password:="pw", UserInterfaceOnly:=False
End If
If numErr = True Then
MsgBox "Only numbers are allowed here.", vbCritical, "Invalid Entry"
End If
End Function
First of all you must enable the "Trust access to the VBA project object model" setting in the Trust Center.
After that you'll have to write something like this:
Sub AddModule()
Dim Module As VBComponent
Dim ModuleString As String
ModuleString = "Sub Test()" & vbCrLf & _
" Msgbox(""Test"")" & vbCrLf & _
"End Sub"
Set Module = Workbooks(2).VBProject.VBComponents.Add(vbext_ct_StdModule)
Module.CodeModule.AddFromString ModuleString
End Sub
Obviously, you will have change the workbook reference and the ModuleString. Also be careful with the trust change. It is there for a reason.
It's not exactly what you were asking, but I would think that you could just create a hidden "template" sheet with the code you want in it (there is an xlVeryHidden option you can use to keep the template sheet from being unhidden from the UI even). Then instead of creating a new worksheet, you create a copy of that "template sheet", which should copy over the sheet VBA code with it.
I have created a userform frmNavigation which has a ListBox1, which will list down all the worksheets present in my workbook and I can double click on any of worksheet listed in the listbox and go to that sheet.
Now as I have close to 50 worksheets so I double click from the list appearing in ListBox1 and go to that sheet but now I want a back button "CommandButton2" so that it can take me back to my previous active sheet.
I have created a code but its not working.
Private Sub CommandButton2_Click()
Application.ScreenUpdating = False
Dim i As Integer, Sht As String
'for loop
For i = 0 To ListBox1.ListCount - 1
'get the name of the selected sheet
If ListBox1.Selected(i) = True Then
Sht = ListBox1.List(i - 1)
End If
Next i
'select the sheet
Sheets(Sht).Select
'reset the userform
Unload Me
frmNavigation.Show
End Sub
Try the code below, I am not sure how to explain my logic of the code below, I tired my best to describe it in the code comments.
I've modified also the ListBox1_DblClick code event, to save the latest ActiveSheet before you Select the new sheet.
Code
Option Explicit
Dim LastSelectedSht As String ' Variable at module level, to store the name of the last selected sheet
'===================================================================
Private Sub CommandButton2_Click()
Dim TmpSht As String
TmpSht = ActiveSheet.Name ' <-- save the current active sheet
' select the previous sheet (stored in LastSelectedSht)
If LastSelectedSht = "" Then
MsgBox "Error, no sheet stored , is it your first time running ? "
Else
Sheets(LastSelectedSht).Select
End If
LastSelectedSht = TmpSht ' <-- use the temp variable to store the latest active sheet
' reset the userform
Unload Me
frmNavigation.Show
End Sub
'===================================================================
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
' modifed code for ListBox double-click event, store the sheet name before switching to the selected item
Dim i As Long
LastSelectedSht = ActiveSheet.Name ' <-- save the current active sheet before selecting a new one
For i = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(i) Then
Worksheets(ListBox1.List(i)).Activate
End If
Next i
End Sub
'=================================================================
Private Sub UserForm_Activate()
Dim ws As Worksheet
For Each ws In ThisWorkbook.Sheets
Me.ListBox1.AddItem ws.Name
Next ws
End Sub
I have a workbook that has a number of worksheets each one with a colaborator name on it (Windows login username).
I've tried via VBA to loop through all Worksheets to match the actual Windows Logged On username with the matching Worksheet, and after the match is done, only that Worksheet is kept visible (with all the others being hiden).
I've managed to do this partially but i can only do it untill it finds the matching worksheet. For example, if the matching username is the third worksheet (in a total of ten for example) the code stops there. I want it to run through all worksheets and only then hide the non matching Worksheets.
First i have the following module:
Sub WorksheetFilter()
Dim Username As String
Dim Worksheetname As String
Worksheetname = ActiveWorkbook.ActiveSheet.Name
Username = Environ("Username")
If Worksheetname <> Username Then
ActiveSheet.Visible = False
End If
End Sub
Then, i call the previous module on the Workbook_Open() event:
Option Explicit
Dim WS As Worksheet
Private Sub Workbook_Open()
For Each WS In ActiveWorkbook.Worksheets
WorksheetFilter
Next
End Sub
Any hints on how this can be achieved?
Thanks,
VĂtor
Use the code below, and put it in the Workbook module under the Workbook_Open event.
Just loop through all sheets and compare each one with the username.
Option Explicit
Public Sht As Worksheet
Private Sub Workbook_Open()
For Each Sht In ThisWorkbook.Sheets
If Sht.Name = Environ("Username") Then
Sht.Visible = xlSheetVisible
Else
Sht.Visible = xlSheetHidden
' option 2: use very hidden, only able to unhide through code (unable to unhide using right-click)
'Sht.Visible = xlSheetVeryHidden
End If
Next Sht
End Sub
Please see below: chopped your code around a bit. You do not need to defien the worksheets name. This is for the module level, you can call it in the workbook open event as per usual
Option Explicit
Dim ws As Worksheet
Dim Username As String
Sub WorksheetFilter()
Username = Environ("Username")
For Each ws In ActiveWorkbook.Worksheets
If ws.Name <> Username Then
ws.Visible = False
Else
ws.Visible = True
End If
Next ws
End Sub
Please let me know how this works for you! :)
I have never come across this idea until now, but is it possible to set another macro to a variable within my current macro to call it from the VBA code? I have made the attempt to do so in my limited knowledge and it ain't working.
What I have is a user form that contains a combo box that is a list of reports. Then I have the selected value from that combo box matched to a specific Sub (by title). Each report has its own macro for updating each month.
I have coded the VBA of my first macro (based on a 'Run' button on the user form) to set a variable (iVal) to equal the value within the cell of the worksheet containing the matching Sub title. I was hoping I could use that variable to call the appropriate Sub title based on that value. It doesn't like the variable.
See a screenshot of the error here: https://i.imgsafe.org/a2a199edb8.png
Otherwise, I'm thinking my best option is to use an array loop. I was hoping to avoid that since this list of possible selections from this combo box is almost 50 different possibilities that could expand or diminish over time. Obviously, this would be time consuming and a challenge to manage as the list of reports and matching macros changed.
I don't even know if this is possible. This is a new VBA challenge I have never tackled before so it falls into that 'I don't know what I don't know' territory. Thanks in advance for any constructive feedback.
Private Sub Run_Click()
'Runs the Analysis
Dim ProjectWB As Workbook
Set ProjectWB = ActiveWorkbook
Dim iWS As Worksheet
Dim sName As String
Dim tName As String
Dim iName As String
Set iWS = Worksheets("Streetwise Ideas")
'Error handling for empty file fields
Application.ScreenUpdating = False
Unload Me
If TextBox1.Value = "" Then
MsgBox "Please select a Source file.", vbCritical, "Error No Source file"
If vbOK Then
UserForm1.Show
End If
Else
If TextBox2.Value = "" Then
MsgBox "Please select a Target file.", vbCritical, "Error No Target file"
If vbOK Then
UserForm1.Show
End If
Else
End If
End If
'place value of the selection from the combobox in cell D2 on "Streetwise Ideas" sheet for referencing later in the macro
iWS.Activate
Range("D2").Select
Selection.Value = cbSWIdeas
sName = TextBox1.Value
tName = TextBox2.Value
'Opens Source workbook file and sets it to variable sWB
Dim sWB As Workbook
Set sWB = Workbooks.Open(sName)
'Opens Target workbook file and sets it to variable tWB
Dim tWB As Workbook
Set tWB = Workbooks.Open(tName)
'Calls the correct macro for the combobox selection
Dim iVal As String
iVal = iWS.Range("E2").Value
If iVal <> "" Then
Call iVal
Else
'do nothing
MsgBox ("No Idea Selected.")
Exit Sub
End If
Application.ScreenUpdating = True
End Sub
You can use Application.Run to call a Macro by name
Sub Example()
Dim MacroName As String
MacroName = "HelloWorld"
Application.Run MacroName
End Sub
Sub HelloWorld()
MsgBox "Hello World!"
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