Excel VBA - LCM - Sub or Function not defined - excel

The following code:
Sub lcm_()
If Selection.Areas.Count <> 1 Then Exit Sub
Dim a As Range
Set a = Selection.Areas(1)
a.Item(1).Value = Lcm(a.Item(1).Value, a.Item(2).Value)
End Sub
produces the error: Compile error: Sub or Function not defined, and I cannot figure out why. I have looked at similar problems, and it seems like the issue is that Excel cannot find the builtin function LCM, but the documentation makes it seem like it doesn't require any special libraries. I am very new to VBA, so it is entirely possible that this is something very simple, but I cannot figure out what.
EDIT:
It is worth noting that if I simply click on a cell and type =LCM(A8,A9), then it works fine.

Try this:
Sub lcm_()
If Selection.Areas <> 1 Then Exit Sub
Dim a As Range
Set a = Selection.Areas(1)
a.Item(1).Value = WorksheetFunction.Lcm(a.Item(1).Value, a.Item(2).Value)
End Sub

Related

Possible to write Code from cells to VBA?

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

VBA: The use of GoTo for non errors

Just a quick question today, I am new to VBA and I am currently writing some code. In the code I use GoTo not for errors but just to write two different parts of functionality. For example the below:
Sub run_FetchTradeFilter()
Dim EntrySelection As Range
Set EntrySelection = Selection
[EntireTradeQuery].Calculate
If [CustomQuery] = True Then GoTo CaseCustomQuery Else GoTo CaseCustomList
CustomQuery:
'fill
'with
'ccde A
CustomList:
'fill
'with
'ccde B
EntrySelection.Select
End Sub
My question is, should I be using GoTo if its not for an error. Or should I be using an if statement or should I be using a SwitchCase?
Great, thanks to both for the clarification! Bets to avoid GoTo. Therefore I will write 2 separate functions and call them in the If statement

Error within If Not IsError function without returning Else

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

Passing a variable defined in a sub onto a function VBA

I´m trying to use a sub to determine a dynamic range which serves as the input to a number of functions. The simplest version of what I´m trying to do looks like this
This approach gives me errors. Putting the subs and functions in different modules doesn´t help. What´s the mistake I´m making?
Global Info As Range
Sub InfoSetter()
Worksheets("Example").Activate
ActiveSheet.UsedRange.Select
Set Info = Selection
End Sub
Function Test() As Variant
Test = Info.Address
End Function
Try the below. This calls the sub from the function that sets the value of info. This means that your info will always be the current UsedRange when the function calculates. Also, using .Activate and .Select is generally considered bad practice. The below code does the same without using either.
Global Info As Range
Sub InfoSetter()
Set Info = Worksheets("Example").UsedRange
End Sub
Function Test() As Variant
Application.Volatile 'Added so function updates automatically when sheet calculates
Call InfoSetter
Test = Info.Address
End Function
Edit: Adding Application.Volatile at the beginning of your function will make it so this updates every time the worksheet calculates.
As per the comment from omegastripes, your error is likely to be because your range is empty. Given Test is a variant suggest you test for an empty range as below
Global Info As Range
Sub TryMe()
MsgBox Test
End Sub
your code
Sub InfoSetter()
Set Info = Worksheets("Example").UsedRange
End Sub
Function Test() As Variant
If Info Is Nothing Then
Test = "Ï'm empty"
Else
Test = Info.Address
End If
End Function

Testing for a picture connected to a link

so I have been searching through this forum for quite a while now, and also on other sites, but I just could not find a way to solve this problem.
So the small problem I got is, that I have a very long Excel Spreadsheet, with many different ID's, or numbers whatever you want to call them. From these ID's I create a custom link, which needs them to direct to a specific image, that is then pasted into a specific cell in this spreadsheet. Note that I really need this code, hence the spreadsheet is about 9300 lines/rows long. The problem now is that not every id has an image attached to it, which means that some links do not work (no image there, but also no text basically an empty page). Is there a way I can just let the code run through it, so that it ignores the error 1004 which is generated, which basically is always telling me he could not find something and will stop at that point.
I am a big noob at VBA, so please when answering do not use to complicated language. I will paste the code below, however the link is confidential, so I will replace the link with "link" or something like that. I tried several On Error methods, but either the error came up again, or Excel crashed, but here is the working code without any modifications to remove this error. Thanks in advance for all the help.
Sub Test()
I = 0
For I = 5 To 9373
If Tabelle2.Cells(I, 9) = "bekannt" Then
Call GetShapeFromWeb("Part 1 of the link" & Tabelle2.Cells(I, 10).Value & "Part 2 of the link", Tabelle2.Cells(I, 13))
End If
Next I
End Sub
Sub GetShapeFromWeb(strShpUrl As String, rngTarget As Range)
Dim shp As Shape
With rngTarget
With .Parent
.Pictures.Insert strShpUrl 'Error Occurs here
Set shp = .Shapes(.Shapes.count)
End With
shp.Left = .Left
shp.Top = .Top
End With
Set shp = Nothing
End Sub
One last thing to notice, some of the words are german, due to me being german and working with german variables, or links, or spreadsheets. And I am using excel 2007. The Error occurs in the following row ".Pictures.Insert strShpUrl" because it can not find a picture to insert.
Thansk a lot.
Kind Regards
Chris
//EDIT
One Idea I might have, which I dont know if it is possible, but the page it is directed to, when a picture is not there it displays the following "Unable to find /part/of/thelink/"
Could one maybe use a code to see if this message is displayed, and maybe check for that? If so how would that work? :) Maybe it could be added to the if statement at the top which tests already for this sub task.
//EDIT
Anyone got some idea? :S Maybe what I posted above in the edit could work? :S Is it possible to check if a msgbox displays something but the other way around so if the msgbox does not equal the following do this. If that could work it would be great! :S Or maybe instead of trying the on error commands trying it with an if statement within the GetShapeFromWeb sub? Any help is greatly appreciated.
This should work. However you wrote that you tried several On Error Methods unsuccessfully ... what does this one for you?
Sub GetShapeFromWeb(strShpUrl As String, rngTarget As Range)
Dim shp As Shape
Dim Er As Long: Er = 0
On Error GoTo gswError
With rngTarget
With .Parent
.Pictures.Insert strShpUrl
If Er <> 0 Then Exit Sub
Set shp = .Shapes(.Shapes.Count)
End With
shp.Left = .Left
shp.Top = .Top
End With
Set shp = Nothing
Exit Sub
gswError:
Er = Err
Resume Next
End Sub
have you tried on the GetShapeFromWeb sub, placing the On Error statement this way:
Sub GetShapeFromWeb(strShpUrl As String, rngTarget As Range)
Dim shp As Shape
On Error GoTo Err1 'inserting a picture from a blank link will cause an error... thus...
With rngTarget
With .Parent
.Pictures.Insert strShpUrl
Set shp = .Shapes(.Shapes.Count)
End With
shp.Left = .Left
shp.Top = .Top
End With
Err1: '...sidestep
Set shp = Nothing
End Sub

Resources