I am trying to use the following macro to assign vba code to a shape.
When using the code I get Runtime Error 438 "Object doesnt support this property or method"
My sheet number always changes, so i cannot hard code it to the code below.
Here is the code I am using:
Sub assignCodeToShape()
Dim x As Integer
x = getSheetNumber
ActiveSheet.Shapes("fileShape").OnAction = Sheets(x) & ".CommandButton1_Click"
End Sub
Function getSheetNumber as Integer()
getSheetNumber =ActiveSheet.Index
End Function
You can do this:
With ActiveSheet
.Shapes("fileShape").OnAction = .CodeName & ".CommandButton1_Click"
End With
Related
I was wondering how I would call something in VBA to write its code while running? So I mean if I had the text in A1 read:
sub Write()
Call OtherScript
End Sub
So again that is text inside the cell not in a VBA script. And then in a script while its running it Calls "A1" and the code that's in A1 gets run through VBA without having to actually put it in there.
This is not a real code obviously, I am really just trying to find out if this is possible. A friend that helps me learn to code and works me through a lot of VBA's said he does not know how that would work so Im posting it here to see if possible.
Please, try the following code. Before running it, write in a cell:
sub WriteSomething()
Call OtherScript
End Sub
You cannot create a function/sub named Write because this word is illegal, meaning something else in VBA.
and in the next cell (on the same row):
sub OtherScript()
MsgBox "Hello!"
End Sub
I used "K2". Use it too, or adapt the range from the code. You should also have a Module3 standard module. Please, update the module name with the one existing in your vbProject. Anyhow, the code can also create the module...
Copy the next code and run it:
Sub write_Run_Subs()
'It needs a reference to 'Microsoft Visual Basic For Applications Extensibility x.x'
Dim vbProj As VBProject, objMod As VBComponent, mdlName As String
Dim rngStr As Range, strSub1 As String, strSub2 As String
Set rngStr = Range("K2")
strSub1 = rngStr.value
strSub2 = rngStr.Offset(0, 1).value
mdlName = "Module3" 'of course, it have to exist in ThisWorkbook vbProject
Set vbProj = ThisWorkbook.VBProject
Set objMod = vbProj.VBComponents(mdlName)
objMod.CodeModule.AddFromString strSub1
objMod.CodeModule.AddFromString strSub2
Application.Run mdlName & ".WriteSomething"
End Sub
It is only a simple code without too much error handling, but it should work... If you run it twice, it will insert two such subs, if not preliminarily check their existence.
If adding the necessary reference looks complicated, please firstly run the following code, which will add it:
Sub addExtenssibilityReference()
'Add a reference to 'Microsoft Visual Basic for Applications Extensibility 5.3':
ThisWorkbook.VBProject.References.AddFromGuid _
GUID:="{0002E157-0000-0000-C000-000000000046}", _
Major:=5, Minor:=3
End Sub
Hi I am trying to adjust an existing excel file (xlsm) of an old colleague.
Basically it are a bunch of forms (different sheets) where you can have several input lines and each input line is its own datapoint. There is a button to add another input line to the sheet.
The code behind the button is defined on each sheet in the VBA editor and the actual function which is called by all these buttons is a module.
The problem is that for two sheets the button works fine and for three other sheets the button gives the error in the title.
The code behind the button is:
Private Sub CommandButton2_Click()
theName = ActiveSheet.Name
Dim var As Integer
var = Range("H3").Value
For i = 1 To var
InsertRowMacro (theName)
Next i
End Sub
and the beginning of the code in the module is:
Sub InsertRowMacro(sheetName)
'first unprotect sheet
ActiveSheet.Unprotect
rangeName = "range_" & sheetName
oorzaakName = "oorzaak_" & sheetName
olmName = "OLM_" & sheetName
Set test = ActiveWorkbook.Names
totalRange = ActiveWorkbook.Names(rangeName).RefersToR1C1
The error is thrown on the final line of this code block. As far as I can see there is no difference between the sheets but my VBA knowledge is limited and the old colleague is ofcourse not available.
Could somebody give me a hint? What could be a possible problem? What could I check?
I have the following short VBA code, what I want is for it to check a cell, B5 for whether it is a Y or a N, and if Y - go to one macro, and if N - go to another macro.
Sub LoadSetup()
Dim Master As Workbook
Set SingleLoad = Setup.Range("B5")
If SingleLoad = "Y" Then
Call LatestLoad
Else
Call TimeSeriesLoad
End If
End Sub
I am getting a Run-rime error '424' Object Required on this line. Any ideas please what could be causing this?
Set SingleLoad = Setup.Range("B5")
I've been trying to solve this error all morning and can't get a handle on it. It looks like Excel really just doesn't want me to set the OnAction property of this shape.
The shape is part of a group of other rectangles/text boxes.
The code works on a non-grouped shape.
workbook has no locked content
no external macros or anything, both functions in same module
Function Macro1()
MsgBox (ActiveSheet.Shapes("box").OnAction) 'Returns the current OnAction string, as expected.
ActiveSheet.Shapes("box").OnAction = "'WorksheetName'!Macro2" '1004 error occurs here
End Function
I've tried setting it to "Macro2" , Macro2 , saving it as a string prior to the OnAction line, and even just trying to set it to an empty string "". No dice.
SOLVED. The group shape interferes with the individual shape properties. The following works to break the group, edit the shape, then regroup:
Function Macro1()
With ActiveSheet
.Shapes("Home").Ungroup
.Shapes("box").OnAction = "Macro2"
With .Shapes.Range("box").Regroup
.Name = "Home"
End With
End With
End Function
Post has been Updated below original post
I am working with two tables and want to have them connected however, the first section contains more values than the second one. I was able to work that out by adding an IfError within the Evaluate function, seen from code example (1) to (2), (using help from If Error Then Blank)
(1)
Worksheets("Sheet1").Range("Cell1").Value = Worksheets("Sheet1").Evaluate("=INDEX(data,MATCH(value,lookup_column,FALSE),column)")
(2)
Worksheets("Sheet1").Range("Cell1").Value = Worksheets("Sheet1").Evaluate("=INDEX(data,MATCH(value,lookup_column,FALSE),column), Cell2")
However, I still would like a message saying that there was an error so I tried
Sub Name()
Application.ScreenUpdating = False
On Error GoTo Msg
Worksheets("Sheet1").Range("Cell1").Value = Worksheets("Sheet1").Evaluate("=INDEX(data,MATCH(value,lookup_column,FALSE),column), Cell2")
Worksheets("Sheet1").Range("Cell1").Value = Worksheets("Sheet1").Evaluate("=INDEX(data,MATCH(value,lookup_column,FALSE),column)")
Exit Sub
Msg: MsgBox "You've had a fatal error"
End
End Sub
It did not return a message, I am assuming this is because the code for VBA was written correctly and it was the Excel function code that had an error. So is there a way to use another function to determine the excel error?
This is a sub part of a larger coding so I know it is something that can be done in excel stand alone, but this is just a minor part of the whole. Thanks in advance.
UDATE:
With comments I was able remove the Evaluate function and replace the original code with the following:
Sub SetWaterfall ()
Application.ScreenUpdating = False
Dim vMatchVal As Variant
If Not IsError(vMatchVal) Then
vMatchVal = Application.Match(Sheets("Sheet1").Range("SelectLine"), Sheets("Sheet1").Range("AS8:AS34"), 0)
Worksheets("Sheet1").Range("AW45").Value = Application.Index(Sheets("Controls").Range("AR8:AR34"), vMatchVal)
Else
Worksheets("Controls").Range("AW45").Value = "Not Data"
MsgBox "First number not found"
End If
End Sub
The issue is still that the index/match functions returns a #NA error and the message box never appears.
(Help converting Index/Match function from Excel formula to VBA code https://www.mrexcel.com/forum/excel-questions/691904-translate-index-match-function-vba-code.html)
(If this edit process is not the correct procedure for let me know and I'll close the post)
In your revised code, you have the If Not IsError test preceding the assignment to the variable you're testing for error!
Let's fix that, and try some other refactoring (for legibility's sake). If this is still not working as expected, you're going to need to provide some example data which others can use to replicate the error.
Sub SetWaterfall()
' It's not necessary to disable ScreenUpdating for this procedure...
' Application.ScreenUpdating = False
Dim theSheet as Worksheet, controls as Worksheet
Dim vMatchVal As Variant
Dim lookupVal as String
Dim matchRange as Range, indexRange as Range
Set theSheet = Sheets("Sheet1")
Set controls = Sheets("Controls")
Set matchRange = theSheet.Range("AS8:AS34")
Set indexRange = controls.Range("AR8:AR34")
lookupValue = theSheet.Range("SelectLine").Value
vMatchVal = Application.Match(lookupVal, matchRange, 0)
If Not IsError(vMatchVal) Then
theSheet.Range("AW45").Value = Application.Index(indexRange, vMatchVal)
Else
controls.Range("AW45").Value = "Not Data"
MsgBox "First number not found"
End If
End Sub