How to call a Sub from another Sub dynamically - vba

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

Related

Excel Add .xlam module inject code into new sheet

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.

Excel VBA not showing userform

I have a VBA macro that opens by asking the user a series of questions (asking them to say which of the open workbooks performs which function). I have a series of userform.show commands as below:
UserForm2.Show ' select cost data file
Set piersBook = ActiveWorkbook
UserForm5.Show ' select IRR file
Set irrBook = ActiveWorkbook
UserForm6.Show ' select BC summary file
Set bcSummary = ActiveWorkbook
(now, after the event, I realise it would have been more simple to put these into one userform).
The net effect is for the last one not to display.
After some research I changed the code to:
UserForm2.Show ' select cost data file
Set piersBook = ActiveWorkbook
UserForm5.Show ' select IRR file
Set irrBook = ActiveWorkbook
DoEvents
UserForm6.Show ' select BC summary file
Set bcSummary = ActiveWorkbook
This worked for about 5 or 6 iterations, before it reverted to the original problem.
I put breakpoints in the userform initialize code. They were all called and the userforms all worked (until I removed the breakpoints again).
Finally I started removing the offending userform: the problem transfered itself to the next one back. And again, when that was removed, to the one before.
The userforms' code is identical:
Private Sub ListBox1_Click()
Workbooks(ListBox1.Value).Activate
Unload Me
End Sub
Private Sub UserForm_Initialize()
Dim wb As Workbook
For Each wb In Workbooks
ListBox1.AddItem wb.Name
Next wb
End Sub
Any thoughts? At the moment I am hardcoding the inputs which is not ideal.
Many thanks.
use only UserForm2, then:
change your UserForm2 code as follows
Private Sub ListBox1_Click()
With Me
If ListBox1.ListIndex <> -1 Then
.Tag = .ListBox1.Value
.Hide
Else
MsgBox "You must select a workbook"
End If
End With
End Sub
Private Sub UserForm_Initialize()
Dim wb As Workbook
For Each wb In Workbooks
ListBox1.AddItem wb.Name
Next wb
End Sub
change your "main" code as follows
Dim piersBook As Workbook, irrBook As Workbook, bcSummary As Workbook
With UserForm2
.Caption = "select cost data file"
.Show ' select cost data file
Set piersBook = Workbooks(.Tag)
.Caption = "select IRR file"
.Show ' select cost data file
Set irrBook = Workbooks(.Tag)
.Caption = "select BC summary file"
.Show ' select BC summary file
Set bcSummary = Workbooks(.Tag)
End With
Unload UserForm2

Excel VBA - On Error Execute Code

Im using Application.FileDialog(msoFileDialogFolderPicker) to choose a folder. This is executed by using a button in userform. However before the user choose the folder a new sheet will be created. Then the open file dialog [Application.FileDialog(msoFileDialogFolderPicker)] will pop up.
Function SelectFolder(Optional msg As String) As String
Dim diaFolder As FileDialog
Set diaFolder = Application.FileDialog(msoFileDialogFolderPicker)
diaFolder.AllowMultiSelect = False
diaFolder.Title = msg
diaFolder.Show
On Error Resume Next
SelectFolder = diaFolder.SelectedItems(1)
On Error GoTo 0
Set diaFolder = Nothing
End Function
The problem arises when user decided to cancel to choose the folder. When this happen, the newly created sheet should be deleted. I tried to use error handler but now luck.
ErrorHandler:
If SheetExists("MS") Then Application.Run "DeleteSheet.deleteSh1"
If SheetExists("MS2") Then Application.Run "DeleteSheet.deleteSh2"
If SheetExists("MT") Then Application.Run "DeleteSheet.deleteSh3"
Application.Run "HideSheets.hideSh"
Resume Next
Exit Sub
Hope you guys can give some idea on this.
why not create the sheet when you have a valid response?
That said, you could check the length of the string you are looking for - 0 means cancel, i.e.
Dim strResponse As String
strResponse = SelectFolder("test")
If Len(strResponse) = 0 Then
MsgBox "user cancelled", vbCritical
'delete sheet
End If
I imagine the above routine SelectFolder is called somehow from a sub that first creates a worksheet then calls it. You could achieve your goal like this:
Sub MyButton_Click()
Dim newWS as worksheet, folder as String
set newWS = sheets.Add
folder = SelectFolder("please select your folder")
If folder = "" Then
newWS.Delete
Else
' ... proceed with the selected folder
End If
End Sub
However, creating the Worksheet before getting the user's answer doesn't seem to me like a good approach, unless there's some strong reason.

Referencing Most Recently Added Worksheet

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

Macro to copy and/or move selected sheets to a new workbook

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