I'm writing some code for a client which pulls data from many differently laid out files. I wanted to write something which was quite flexible for him in the future.
Therefore, he will be able to write for example y.offset(0,1) in a cell depending where in regards to the variable y the data will be.
The reason I haven't just made the the variable 1 is because it, and therefore the cell, may or may not include multiple & "blah blah"
Basically, I'm wondering if it's possible to write parts of code in a cell then pull them up and incorporate them into code.
For instance:
Dim y as range
Dim x as range
Dim c as string
Set Y = Sheet1.range("G4")
c = sheet1.range("A1") [which contains the words y.offset(0,4)
Set x = c
This doesn't work, however I'm wondering if there's anything that can be done to get the same result.
Your need is kind of a recursive and dangerous one
then it deserves such a recursive and dangerous answer
you could use the VBA Project Object Model (see here for info) and act as follows:
Set your project to handle VBA Object Model
follow all the steps you can see in the Introduction of the above given link to cpearson website Add reference to your project
Disclaimer: please also read the CAUTION note in there
add "helper" module
add to your project a new Module and call it after "HelperModule" (you can call it as you like, but then be consistent with the chosen name)
then add this code into this new module
Function GetRange(refRng As Range) As Range
Set GetRange = refRng
End Function
Function SetToCellContent(refRng As Range, cellContent As String) As Range
UpdateCodeModule cellContent
Set SetToCellContent = HelpModule.GetRange(refRng)
End Function
Sub UpdateCodeModule(cellContent As String)
Dim CodeMod As VBIDE.CodeModule
Dim LineNum As Long
Set CodeMod = ActiveWorkbook.VBProject.VBComponents("HelperModule").CodeModule
LineNum = SearchCodeModuleLine(CodeMod, "Set GetRange")
CodeMod.ReplaceLine LineNum, " Set GetRange = " & cellContent
End Sub
Function SearchCodeModuleLine(CodeMod As VBIDE.CodeModule, FindWhat As String) As Long
Dim SL As Long ' start line
Dim SC As Long ' start column
Dim EL As Long ' end line
Dim EC As Long ' end column
Dim Found As Boolean
With CodeMod
SL = 1
EL = .CountOfLines
SC = 1
EC = 255
Found = .Find(Target:=FindWhat, StartLine:=SL, StartColumn:=SC, EndLine:=EL, EndColumn:=EC, wholeword:=True, MatchCase:=False, patternsearch:=False)
End With
SearchCodeModuleLine = SL
End Function
Add this code to your main code
Set x = SetToCellContent(y, c) '<--| call the function that will take care of updating code in 'GetRange()' function and returns a range relative to 'y' as per the "code" in 'c'
Related
My question is a little different here because I am trying to call a sub-procedure that has passed a dictionary as a parameter and it keeps returning the error 'Argument not optional'. Please help!
Sub Code1()
Call sub_input
End Sub
Sub sub_input (dicDat as Dictionary)
Dim ws As Worksheet: Set ws =ActiveSheet
Dim i As Integer
Dim j As Integer
Dim vTemp As Variant
Range("rInputStart").Parent.Calculate
vTemp =Range(Range("rInputStart").Offset(1),_
Range("rInputStart").End(xlDown).Offset(0,2)).value
Dim price as Long
Dim currency As String: currency = vbNullString
Dim exchangeRate as String: exchangeRate = vbNullString
Dim remark as String: remark = vbNullString
For j =1 To 10
price = price & dicDat ("price" & CStr (j))&"|"
price = price ("rPriceManual").value
currency = currency & dicDat("dl_currency"&CStr(j))&"|"
exchangeRate =(exchangeRate & _
dicDat("exchange_rate"&CStr(j))&"|")/100
Remark= remark & dicDat("remarks"&CStr(j))&"|"
For i =LBound(vTemp,1)ToUBound(vTemp,1)
If vTemp(i,1)="currency"And dicDat(dl_currency)<> vbNullString _
Then
vTemp(i,3)= currency
Endif
If vTemp(i,2)="remark"Then
vTemp(i,3)=Remark
EndIf
If vTemp(i,2)="exchangeRate"Then
vTemp(i,3)= exchangeRate
EndIf
Next i
Next j
End Sub
Try creating a scripting.dictionary object to pass over to the sub.
Option Explicit
Sub Code1()
Dim dict As New Scripting.Dictionary
dict.Item(10) = "abc"
dict.Item(11) = "bcd"
dict.Item(12) = "cde"
sub_input dict
End Sub
Sub sub_input(dicDat As Scripting.Dictionary)
Dim k As Variant
For Each k In dicDat.keys
Debug.Print k & " - " & dicDat.Item(k)
Next k
End Sub
If you prefer late-binding, use dim dict as object then set dict = createobject("scripting.dictionary").
To use this code, go into the VBE's Tools, References then locate Microsoft Scripting Runtime and put a check beside it to include this library in your project. Library references like this are on a project-to-project basis, not a computer-to-computer basis. If you run your workbook on another computer, it will be carried across.
You have called the sub sub_input but you are calling sub_book also sub_input requires a parameter sub_input(dicDat as Dictionary) but you are not adding a parameter to your call code.
For example:
if you called a sub sub Test but then add (name as string) next to it to make Sub Test(Name as string) you are making a variable that is necessary to run the sub. If you wanted to call this sub you would need to call it with a value to give the Name variable as it is a string you would need to surround that with "". as an example one way you could call this is call Test("Geoff") "Geoff" being the name string
The error you are getting is because you have not called your sub with nol value to the dicDat parameter. your code should look like: `call sub_input(TestValue) then that gives your 'dicDat' a value
For a more detailed explanation of argument not optional errors see here.
My suggestion is at the top of every module/class/sheet where you are going to add code type option explicit at the top and then you will find any typos on names or subs
Hope this helps
I might be bad at googling as I couldn't find the answer to below question:
Sub TEST()
Dim sthstring as string
sthstring = "Hello World"
end sub
While we all know it's easy to use msgbox to print "Hello world", is it possible to print out the variable's name (which in this case, "sthstring") and how?
EDIT: please do not provide with answer such as:
Dim someotherstring as string
someotherstring = "sthstring"
as I meant to find a way to print the 'name' of the variable, thanks
After reading comments I think you may find this answer useful.
VBA doesn't support reflection just like #Monty Wild has mentioned already but adding references to Microsoft Visual Basic for Applications Extensibility 5.3 grants you the access the VBE object. You can then iterate object modules in your VBA Project and retrieve the entire code for a module in a String format.
Consider the following (Stick it in a new workbook's Module1)
Sub Main()
Dim code As String
code = GetCodeModule("Module1")
Debug.Print code
End Sub
Private Function GetCodeModule(ByVal codeModuleName As String) As String
Dim VBProj As VBIDE.VBProject
Dim VBComp As VBIDE.VBComponent
Dim CodeMod As VBIDE.CodeModule
Set VBProj = ThisWorkbook.VBProject
Set VBComp = VBProj.VBComponents(codeModuleName)
Set CodeMod = VBComp.CodeModule
GetCodeModule = CodeMod.Lines(1, CodeMod.CountOfLines)
End Function
Your code variable now stores the exact code that is in your Module1 you can check that by opening the Immediate Window ctrl+g.
You may want to write/use some sort of a Find function to disassemble the String components to retrieve variable names and values but I wouldn't recommend doing it as it's can get quite tricky.
You can go a step further that simply accessing the code.
Updating the excellent code from Pearson to
show that setting the reference to Microsoft Visual Basic for Applications Extensibility 5.3 isnt a pre-requisite to access the VBIDE
actually parse out any Dim XX As String in any codemodule and report it
sample output
Dim sthstring As String (Module1 at: Line: 2)
Dim strSub As String (Module2 at: Line: 2)
Dim FindWhat As String (Module2 at: Line: 11)
Dim ProcName As String (Module3 at: Line: 9)
code
Sub GetVariable()
Dim strSub As String
strSub = "As String"
Call SearchCodeModule(strSub)
End Sub
Function SearchCodeModule(ByVal strSub)
Dim VBProj As Object
Dim VBComp As Object
Dim CodeMod As Object
Dim FindWhat As String
Dim SL As Long ' start line
Dim EL As Long ' end line
Dim SC As Long ' start column
Dim EC As Long ' end column
Dim Found As Boolean
Set VBProj = ActiveWorkbook.VBProject
For Each VBComp In VBProj.VBComponents
Set CodeMod = VBComp.CodeModule
With CodeMod
SL = 1
EL = .CountOfLines
SC = 1
EC = 255
Found = .Find(target:=strSub, StartLine:=SL, StartColumn:=SC, _
EndLine:=EL, EndColumn:=EC, _
wholeword:=False, MatchCase:=False, patternsearch:=False)
Do Until Found = False
If Left$(Trim(.Lines(SL, 1)), 3) = "Dim" Then Debug.Print Trim(.Lines(SL, 1) & " (" & CStr(VBComp.Name) & " at: Line: " & CStr(SL)) & ")"
EL = .CountOfLines
SC = EC + 1
EC = 255
Found = .Find(target:=strSub, StartLine:=SL, StartColumn:=SC, _
EndLine:=EL, EndColumn:=EC, _
wholeword:=True, MatchCase:=False, patternsearch:=False)
Loop
End With
Next VBComp
End Function
This is difficult to do directly, as VBA does not have reflection, i.e. cannot directly reference itself.
However;
Since in a comment you mention that you want to write code that references itself, you can do so by referencing Microsoft Visual Basic for Applications Extensibility 5.3 in the tools/references dialog. This gives you the ability to reference VBA code, and from there you could write code that prints itself out.
See
MSFT reference 1, and
MSFT reference 2
That is likely impossible, as variable names are just pointers to data. You can have several variables that all point to the same object (although in VBA I do not believe strings are treated as objects so that would not be possible, with the exception of a ByRef function call).
I just want to be able to search a range of cells for a value from a combobox then if found store it somewhere to be used in a bunch of other calculations but I can't get it to work at all.
I really don't understand what the find function is actually doing. Does it return a range variable that identifies where the input has been found? And if so how do I reference/use that range?
Please don't just post code without an explanation I would really like to understand what is going on here.
Sub run_averages()
Dim x As Integer
Dim rngFindValue As Range
Set dd = ActiveSheet.DropDowns("thing")
Set aa = ActiveSheet.DropDowns("otherthing")
With Range("E3:DI3")
Set rngFindValue = .Find(What:=" & aa &", _
After:=ActiveSheet.Range("E3"), LookIn:=xlFormulas)
With rngFindValue
rngFindValue.Active
End With
End With
End Sub
using the following code as you did:
Set rngFindValue = .Find(What:=" & aa....
You reference found cell as Range. Therefore if you want to work with values of that particular cell, you can work with it as with any Range() -> rngFindValue.Value
Try this out:
Dim x As Long
Dim myitem As String, rngFindValue As Range
x = Activesheet.Shapes("thing").ControlFormat.Value
myitem = Activesheet.Shapes("thing").ControlFormat.List(x)
With Range("E3:DI3")
Set rngFindValue = .Find(what:=myitem, after:=[DI3], LookIn:=xlFormulas)
rngFindValue.Select '~~> or do whatever you want with your found range
End With
I am going nuts here ! I cannot understand the error messaging that I'm being given.
Sub run_averages()
Dim x As Integer
Dim rngFindValue As Range
Dim rngFindstart As Range
Dim myitem As Integer
Set dd = ActiveSheet.DropDowns("thing_length")
Set aa = ActiveSheet.DropDowns("thing_date")
myitem = ActiveSheet.Cells(5, 1).Value
' using beans text to make sure error is not coming from drop down reference
Set rngFindValue = Range("E3:DI3").Find(What:="beans", After:=ActiveSheet.Range("E3"), LookIn:=xlFormulas)
With ActiveSheet
.Range(.Cells(3, 1), .Cells(rngFindValue.Row, rngFindValue.Column)).Select
End With
End Sub
It is telling me that "Run time error 91 Object variable or With block not set" if rngFindValue is the only object i am using then it has been set by the fact it is created..
What object does not exist ?
I am clearly missing something fundamental.
Thanks.
Wait. I'm a noob. There was no "beans" text in the document so it was giving me that error...
I am trying to obtain a reference to a Shape in a Worksheet, corresponding to a ChartObject. I found no certain way of doing this. The only approximation, by trial-and-error and simply tested in a few cases, is assuming that the ZOrder of a ChartObject is the same as the Index of the corresponding Shape:
Function chobj2shape(ByRef cho As ChartObject) As Shape
' It appears that the ZOrder of a ChartObject is the same as the Index of
' the corresponding Shape, which in turn appears to be the same as its ZOrderPosition
Dim zo As Long
Dim ws As Worksheet
Dim shc As Shapes
Dim sh As Shape
zo = cho.ZOrder
Set ws = cho.Parent
Set shc = ws.Shapes
Set sh = shc.Item(zo)
Set chobj2shape = sh
'Set sh = Nothing
End Function
(a slight excess of defined variables is used for debugging purposes).
Is there any more certain way of doing this?
Any identifier used for picking the correct Shape should be unique. The name is not necessarily unique (see https://stackoverflow.com/questions/19153331/duplicated-excel-chart-has-the-same-name-name-as-the-original-instead-of-increm), so it is not guaranteed to work. The Index/ZOrderPosition is just a guess, at least satisfying the requirement of uniqueness.
Edit: see answer by #Andres in Excel VBA: Index = ZOrderPosition in a Shapes collection?. It is clear that the ZOrder of a ChartObject is not equal to the Index of either the ChartObject or the corresponding Shape (and I have verified this).
But it appears that ZOrder is equal to ZOrderPosition of the corresponding Shape. This was verified with dump_chartobjects:
Sub dump_chartobjects()
' Dump information on all ChartObjects in a Worksheet.
Dim coc As ChartObjects
Set coc = ActiveSheet.ChartObjects
Dim cho As ChartObject
Dim ich As Long
For ich = 1 To coc.Count
Dim msg As String
Set cho = coc(ich)
With cho
msg = "ChartObject '" & .name & "'" _
& ", type name: " & TypeName(cho) & ", at: " & .TopLeftCell.Address _
& ", index: " & ich & ", .Index: " & .Index _
& ", ZOrder: " & .ZOrder
'& ", hyperlink: " & .Hyperlink
End With
Debug.Print msg
Dim ish As Long
ish = choidx2shpidx(ich, coc.Parent)
Next ich
End Sub
Function choidx2shpidx(coidx As Long, ws As Worksheet) As Long
Dim cozo As Long
Dim coc As ChartObjects
Dim co As ChartObject
Set coc = ws.ChartObjects
Set co = coc(coidx)
cozo = co.ZOrder
choidx2shpidx = zo2idx_shp(cozo, ws)
Dim con As String, shn As String
Dim sh As Shape
Set sh = ws.Shapes(choidx2shpidx)
con = co.name
shn = sh.name
Dim cox As Double, coy As Double
Dim cow As Double, coh As Double
Dim shx As Double, shy As Double
Dim shw As Double, shh As Double
cox = co.Left
coy = co.top
cow = co.Width
coh = co.Height
shx = sh.Left
shy = sh.top
shw = sh.Width
shh = sh.Height
If ((con <> shn) Or (cox <> shx) Or (coy <> shy) Or (cow <> shw) Or (coh <> shh)) Then
Dim msg As String
msg = "ChartObject: '" & con & "', Shape: '" & shn & "'"
'Debug.Print msg
MsgBox msg
choidx2shpidx = -1
End If
End Function
Function zo2idx_shp(zo As Long, ws As Worksheet) As Long
Dim ish As Long
Dim shc As Shapes
Dim sh As Shape
Set shc = ws.Shapes
For ish = 1 To shc.Count
Set sh = shc(ish)
If (sh.ZOrderPosition = zo) Then
zo2idx_shp = ish
Exit Function
End If
Next ish
zo2idx_shp = -1
End Function
After losing hours in a similar issue, I found a couple of concepts related to referencing shapes in excel, but none satisfies me 100%. For accessing a shape you have 4 pure methods:
Shape.Name : Is FAST, but NOT RELIABLE. The name of the shape could be used to get a reference of a shape but provided you don't have duplicated names. Code: ActiveSheet.Shapes("Shape1")
Shape.ZOrderPosition : Very FAST, but NOT RELIABLE. The ZOrder of the shape could be used to get a reference of a shape, because is the same as the index of the shape in the shapes collection. But provided you don't have group of shapes that breaks previous rule (See: https://stackoverflow.com/a/19163848/2843348). Code: ActiveSheet.Shapes(ZOrderFromOneShape)
Set shpRef=Shape: FAST, RELIABLE, but NOT PERSISTENT. I try to use this always I can, specially when I create a new shape. Moreover, if I have to iterate on the new shapes later one I try to keep the object reference inside a collection. However not Persistent, that means if you stop and run you VBA code again to will loose all the references and collection. Code: Set shp = NewShape, or you can add it to a collection: coll.add NewShape for loop it later on.
Shape.ID : RELIABLE, PERSISTENT, but not directly supported! The ID of the shape is very reliable (don't change and cannot be duplicates IDs in a Sheet). However, there is no direct VBA function to get a shape back knowing its ID. The only way is to loop thorough all shapes until the ID match the ID you was looking for, but this can be very SLOW!.
Code:
Function FindShapeByID(ws as excel.worksheet, ID as long) as Excel.Shape
dim i as long
set FindShapeByID = nothing 'Not found...
for i = 1 to ws.shapes.count
if ws.shapes(i).ID = ID then
set FindShapeByID = ws.shapes(i) 'Return the shape object
exit function
end if
next i
End Function
Note 1: If you want to access this function several times, you can improve it by using a cache of Shape IDs. That way you will make the loop only one time.
Note 2: If you move a shape from one sheet to other, the ID of the shape will change!
By mixing and using above knowledge, I have concluded in two main approaches:
FIRST APPROACH
FASTEST BUT VOLATILE: (same as point#3) Try to keep the reference in a object as longer you can. When I have to iterate trough a bunch of shapes later on, I save the references inside a collection and I avoid to use other secondary reference like the name, ZOrder or ID.
For example:
dim col as new Collection
dim shp as Excel.Shape
'' <- Insert the code here, where you create your shape or chart
col.add shp1
'' <- Make other stuffs
for each shp in col
'' <- make something with the shape in this loop!
next shp
The problem of course is that the collection and reference are not permanent. You will loose them when you stop and restart the vba code!
SECOND APPROACH
PERSISTENT: My solution is to save the name and the ID of the shape for later reference. Why? Having the name I can access the shape very fast most of the time. Just in case I found a duplicated name I make the slow loop searching the ID. How can I know if there is a name duplicated? Very simple, just check the ID of the first name search, and if they don't match you have to suppose is duplicated.
Here the code:
Function findShapeByNameAndID(ws As Excel.Worksheet, name As String, ID As Long) As Shape
Dim sh As Excel.Shape
Set findShapeByNameAndID = Nothing 'Means not found
On Error GoTo fastexit
Set sh = ws.Shapes(name)
'Now check if the ID matches
If sh.ID = ID Then
'Found! This should be the usual case!
Set findShapeByNameAndID = sh
Else
'Ups, not the right shape. We ha to make a loop!
Dim i As Long
For i = 1 To ws.Shapes.Count
If ws.Shapes(i).ID = ID Then
'Found! This should be the usual case!
Set findShapeByNameAndID = ws.Shapes(i)
End If
Next i
End If
fastexit:
Set sh = Nothing
End Function
Hope this helps you!
Note 1: Is you want to search shapes that maybe inside groups, then the function is more complicated.
Note 2: The ZOrder looks nice, but cannot find it useful. When I tried to take advantage of it, there was always a missing part...
#TimWilliams is almost right (in his comment). However, there are some situation where Tim's idea could get confusing results.
I think the following code will be more appropriate and correct.
Sub qTest()
Dim cho As ChartObject
Set cho = ActiveSheet.ChartObjects(1)
Dim SH As Shape
Set SH = cho.ShapeRange.Item(1)
SH.Select 'here Shape will be selected..
Debug.Print TypeName(SH) '...which we can check here
End Sub
Is it possible to Evaluate a String which contains a valid Excel VB Constant's Name
to return that Constant's Value?
eg
Dim ConstantName as String
Dim ConstantValue as Long
ConstantName="xlValues"
ConstantValue= UnknownFunction(ConstantName)
'would set ConstantValue=-4163
Fun!
Option Explicit
Function getConstantValue(constStr As String) As Variant
Dim oMod As VBIDE.CodeModule
Dim i As Long, _
num As Long
Set oMod = ThisWorkbook.VBProject.VBComponents("Module1").CodeModule
For i = 1 To oMod.CountOfLines
If oMod.Lines(i, 1) = "Function tempGetConstValue() As Variant" Then
num = i + 1
Exit For
End If
Next i
oMod.InsertLines num, "tempGetConstValue = " & constStr
getConstantValue = Application.Run("tempGetConstValue")
oMod.DeleteLines num
End Function
Function tempGetConstValue() As Variant
End Function
All code must be in a module called Module1. That can be changed pretty simply by changing the text "Module1" in the routine.
You'll need to add a reference to Microsoft Visual Basic for Applications Extensibility x.x
There are a number of ways this could fail. Let me know if you have any problems with it :)
Instead of using constants, you could use a dictionary
Dim dict As Object
Sub InitialiseDict()
Set dict = CreateObject(Scripting.Dictionary)
dict("xlValues") = -4163
dict("const1") = value1
...
dict("constN") = valueN
End Sub
ConstValue = dict("xlValues")
Is using the string value necessary?
Dim anyConstant as Long
anyConstant = xlValues
msgbox anyConstant
Set anyConstant to any xl constant you please, they are all enumerated Long values.
The first solution offered is indeed much more fun however.