I'd like to use the .DeleteLinesfunction in VBA. As I'm not deleting all the lines in the module i need a targeted approach. I assume there is a function like Find("FooBar").LineNumber, however I can't find it here/with google:
https://msdn.microsoft.com/en-us/library/office/gg264546.aspx
Sub Deletings()
With Workbooks("ClassExperiment.xlsm").VBProject.VBComponents("Module2").CodeModule
.DeleteLines(HowDoIGetThisValue, 0)
End With
End Sub
Help appreciated.
If you're removing the entire procedure, you can find its location with the ProcStartLine property and the line count with ProcCountLines.
Dim module As CodeModule
Set module = Workbooks("ClassExperiment.xlsm").VBProject.VBComponents("Module2").CodeModule
Dim start As Long
Dim lines As Long
With module
start = .ProcStartLine("button_Click", vbext_pk_Proc)
lines = .ProcCountLines("button_Click", vbext_pk_Proc)
.DeleteLines start, lines
End With
Warning:
This should be obvious, but I'll throw it out there anyway. Do not use this (or any other method) to alter the module that the code is running from in Debug mode. This is a good way to break your workbook.
Sub test()
Dim vb As VBComponent
Dim i As Integer
Set vb = ThisWorkbook.VBProject.VBComponents("Module2")
For i =vb.CodeModule.CountOfLines to 1 step -1
If InStr(1, vb.CodeModule.Lines(i, 1), "' remove") <> 0 Then
vb.CodeModule.DeleteLines i, 1
End If
Next i
End Sub
I would of also suggested using a condition statement to allow execution of the code line, rather than deleting it, when is it put back? this could cause issues if you wish to automate that bit, as you'll need to know where it came from.
Related
Prior to 2017 I had a VBA macro routine that would close all open VBA modules (except the one containing the macro).
It looked SOMETHING like this:
Sub Close_Modules_1()
Dim iTemp As Integer
For iTemp = ThisWorkbook.VBProject.VBE.Windows.Count To 1 Step -1
With ThisWorkbook.VBProject.VBE
.Windows (iTemp) '<- Invalid use of property
End With
Next
Debug.Print "Done."
End Sub
Can anyone provide a working routine that closes all VBA modules? I've ended up with over 100 open modules at times.
Did Microsoft in its wisdom make acting on modules illegal in Excel 2016/2019/Excel 365?
Thanks in advance for helpful ideas.
Use this:
Private Sub X_Click()
Dim iTemp As Integer
For iTemp = ThisWorkbook.VBProject.VBE.Windows.Count To 1 Step -1
Debug.Print ThisWorkbook.VBProject.VBE.Windows(iTemp).Caption
If InStr(ThisWorkbook.VBProject.VBE.Windows(iTemp).Caption, "(") > 0 Then
ThisWorkbook.VBProject.VBE.Windows(iTemp).Close
End If
Next
End Sub
Do not forget to check this option first:
I'm trying to build a dynamic progress bar in Excel, and the way I'm currently doing this is by hard-coding a number of steps into my script as the "total number of steps"... the Application.StatusBar code gets updated with a counter that is divided by this total.
What I'd like to do is to have "TotalSteps" pre-populate with 3 (using the example below) by searching ahead through the code to identify the number of times "Call fnProgress" appears in the subroutine.
Public Sub Example()
TotalSteps = 3 'Enter a value here equal to the number of times "Call fnProgress" appears below
Call ABC
Call fnProgress
Call 123
Call fnProgress
Call DoReMi
Call fnProgress
End Sub
I don't get the impression this is possible in VBA, but I figured someone here would know how to do it if it was! Or perhaps someone could offer a better solution to my simple progress bar... Being able to search ahead in the actual code is also an interesting problem, to me, and I'd imagine it's got further application beyond my status bar.
Thanks so much!
-Julia :)
It is possible, but it's not pretty.
I would consider the solution below bad practice in most cases. Anyway - here it goes:
Sub Test()
Dim StepCount As Integer
Dim TotalSteps As Integer
Steps = Array("Abc", "Def", "Ghi")
TotalSteps = UBound(Steps) + 1
For Each Step In Steps
StepCount = StepCount + 1
ActiveSheet.Evaluate Step & "()+0" '+0 is workaround to handle a bug in VBA. Without it, the method is called twice
Progress StepCount, TotalSteps
Next
End Sub
Sub Progress(StepCount As Integer, TotalSteps As Integer)
Debug.Print StepCount & "(" & TotalSteps & ")"
End Sub
Sub Abc()
Debug.Print "Abc"
End Sub
Sub Def()
Debug.Print "def"
End Sub
Sub Ghi()
Debug.Print "ghi"
End Sub
The base for this is the Evaluate function, that allows you to evaluate expressions in strings. The Test method calls the methods in the Steps array, using Evaluate.
Here's a different approach. Not a good way to write code, but again, there are situations where it is warranted.
Start by adding a reference to Microsoft Visual Basic for Applications Extensibility, then add this code:
Sub Test()
Dim CodeMod As VBIDE.CodeModule
Set CodeMod = ActiveWorkbook.VBProject.VBComponents("Module1").CodeModule
Debug.Print CountOccurrences("Call fnProgress", CodeMod.Lines(1, CodeMod.CountOfLines)) - 1 'Remove 1 to ignore this line
End Sub
Function CountOccurrences(SoughtString As String, InString As String) As Long
CountOccurrences = (Len(InString) - (Len(Replace(InString, SoughtString, "")))) / Len(SoughtString)
End Function
The module name is hardcoded. It reads the code, counts the number of occurences of Call fnProgress and subtracts one (so that the count it self isn't counted). Adjust as needed.
I'm still fairly new to VBA and struggling with its limitations (and mine!). Here's my code:
Sub updateCache(CacheKey As String, CacheValue As Variant)
Dim DataCacheWorksheet As Worksheet, CacheRange As Range, Found As Variant, RowNum As Integer
Set DataCacheWorksheet = ThisWorkbook.Worksheets("DataCache")
Set CacheRange = DataCacheWorksheet.Range("A1:B999")
Set Found = CacheRange.Find(What:=CacheKey)
If Found Is Nothing Then
RowNum = CacheRange.Cells(Rows.Count, 2).End(xlUp).Row
DataCache.Add CacheKey, CacheValue
On Error Resume Next
DataCacheWorksheet.Cells(1, 1).Value = CacheKey
DataCacheWorksheet.Cells(1, 2).Value = CacheValue
Else
'Do other things
End If
End Sub
When I step through the code, Excel simply exits the sub at the line DataCacheWorksheet.Cells(1, 1).Value = CacheKey, with no error. So, two questions:
What's the bug that's preventing the value from being updated?
Why does Excel ignore my On Error command?
Edit: If I run the line in the IDE's "Immediate" box, I get the error "Run-time error '1004' Application-defined or object-defined error. I get the same error regardless of the value of CacheKey (I tried Empty, 1234 and "Hello").
Edit 2: If I modify the sub so that CacheKey and CacheValue are hardcoded and the reference to DataCache is removed, and then I run the sub standalone it works. So why doesn't it work when called from another function? Is it possible that Excel is locking cells while doing calculations?
Not sure if this applies, but you mentioned you were calling this macro from another function. If you are calling it from a function, depending on how you are calling it, that would explain your problem. For example, a worksheet function entered into a cell cannot modify another cell on the worksheet. And the attempt to do so will result in the macro merely exiting at that point, without throwing a VBA error.
How to work around this depends on specifics you have yet to share. Sometimes, worksheet event code can be useful.
Ok, wasn't about to write an answer, but there are 3 things you should modify in your code:
Found As Range and not As Variant
RowNum As Long in case it's a row after ~32K
To trap errors usually On Error Resume Next won't help you, it will just jump one line of code. You need to handle the error situation.
Modified Code
Sub updateCache(CacheKey As String, CacheValue As Variant)
Dim DataCacheWorksheet As Worksheet, CacheRange As Range, Found As Range, RowNum As Long ' < use Long instead of Integer
Set DataCacheWorksheet = ThisWorkbook.Worksheets("DataCache")
Set CacheRange = DataCacheWorksheet.Range("A1:B999")
Set Found = CacheRange.Find(What:=CacheKey)
If Found Is Nothing Then ' check if not found in cache (*Edit 1)
RowNum = CacheRange.Cells(Rows.Count, 2).End(xlUp).Row
DataCache.Add CacheKey, CacheValue ' I assume you have a `Dictionary somewhere
' On Error Resume Next <-- Remove this, not recommended to use
DataCacheWorksheet.Cells(1, 1).Value = CacheKey
DataCacheWorksheet.Cells(1, 2).Value = CacheValue
Else
'Do other things
End If
End Sub
Lets say I have the following:
Public Sub Information()
'TEST
End Sub
Is there a way to get "TEST" as a result?
Somehow through VBA?
E.g. - In PHP there is a good way to take the comments. Any ideas here?
Edit:
There should be a way, because tools like MZ-Tools are able to provide the comments when they generate the documentation.
You need to parse the code yourself, using the VBA Extensibility library (aka "VBIDE API"). Add a reference to the Microsoft Visual Basic for Applications Extentibility 5.3 type library, and then you can access types such as CodePane and VBComponent:
Sub FindComments()
Dim component As VBComponent
For Each component In Application.VBE.ActiveVBProject.VBComponents
Dim contents As String
contents = component.CodeModule.Lines(1, component.CodeModule.CountOfLines)
'"contents" now contains a string with the entire module's code.
Debug.Print ParseComments(contents) 'todo
Next
End Sub
Once you have a module's contents, you need to implement logic to find comments... and that can be tricky - here's some sample code to play with:
Sub Test()
Dim foo 'this is comment 1
'this _
is _
comment 2
Debug.Print "This 'is not a comment'!"
'..and here's comment 3
REM oh and guess what, a REM instruction is also a comment!
Debug.Print foo : REM can show up at the end of a line, given an instruction separator
End Sub
So you need to iterate the lines, track whether the comment is continuing on the next line / continued from the previous line, skip string literals, etc.
Have fun!
After some tests, I got to this solution:
simply pass the name of the code-module to the function and it will print all comment lines. Inline comments won't work(you have to change the condition)
Function findComments(moduleName As String)
Dim varLines() As String
Dim tmp As Variant
With ThisWorkbook.VBProject.VBComponents(moduleName).CodeModule
'split the lines of code into string array
varLines = Split(.lines(1, .CountOfLines), vbCrLf)
End With
'loop through lines in code
For Each tmp In varLines
'if line starts with '
If Trim(tmp) Like "'*" Then
'print comment line
Debug.Print Trim(tmp)
End If
Next tmp
End Function
You can use Microsoft Visual Basic for Applications Extensibility to examine code at runtime:
'Requires reference to Microsoft Visual Basic for Applications Extensibility
'and trusted access to VBA project object model.
Public Sub Information()
'TEST
End Sub
Public Sub Example()
Dim module As CodeModule
Set module = Application.VBE.ActiveVBProject.VBComponents(Me.CodeName).CodeModule
Dim code As String
code = module.lines(module.ProcStartLine("Information", vbext_pk_Proc), _
module.ProcCountLines("Information", vbext_pk_Proc))
Dim lines() As String
lines = Split(code, vbCrLf)
Dim line As Variant
For Each line In lines
If Left$(Trim$(line), 1) = "'" Then
Debug.Print "Found comment: " & line
End If
Next
End Sub
Note that the above example assumes that it's running in a Worksheet or Workbook code module (hence Me when locating the CodeModule). The best method for locating the correct module will depend on where you want to locate the procedure.
You could try with reading line by line of code in your module. Here is just idea returning first comment for further improvements:
Sub callIt()
Debug.Print GetComment("Module1")
End Sub
Function GetComment(moduleName As String)
Dim i As Integer
With ThisWorkbook.VBProject.VBComponents(moduleName).CodeModule
For i = 1 To .CountOfLines
If Left(Trim(.Lines(i, 1)), 1) = "'" Then
'here we have comments
'return the first one
GetComment = .Lines(i, 1)
Exit Function
End If
Next i
End With
End Function
Important! in Reference window add one to 'Microsoft Visual Basic for Applications Extensibility'.
I have the following code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim RR As Range
Dim TestArea As Range
Dim foremenList As Range
Dim workerList As Range
Dim workers As Range
Dim Foremen As Range
Dim i As Integer
Dim R As Range
Dim EmplList() As Variant
Set TestArea = Sheet90.Range("b4:q8", "b15:q19", "b26:q30")
Set foremenList = Sheet90.Range("V24:V30")
Set RR = Sheet90.Range("AA25:AA46")
i = 0
For Each R In RR.Cells
If Len(R.Value) > 0 Then
EmplList(i) = R.Value
i = i + 1
End If
Next R
Dim ValidStr As String
Set ValidStr = Join(EmplList, ",")
With Sheet90.Range("b26").Validation
.Delete
.Add xlValidateList, xlValidAlertStop, _
xlBetween, "1,2,3"
End With
Sheet90.Range("b40").Value = "Test"
End Sub
But when I press run to test it, it prompts me for a macro name.
Additionally, it does not trigger on Worksheet_Changeany more.
Is this an error (i.e. I forgot a semicolon or something) that consistently triggers Excel VBA to behave like this? If so, what should I look for in the future?
The reason you can't run this one with the Run Sub button is because it requires a parameter. If you want to run this standalone, one possibility is to run it in the Immediate Window so you can manually pass in the parameter. Since this one is expecting a more complex data type (range) you may want to create a small sub to call it so that you can properly create your range and pass that in. Then you can use the Run Sub on this sub which will call your other one.
As far is it not triggering on Worksheet_Change, I am not able to tell what is causing it just from what you posted. However, you do need to make sure that it is located on the code page for the worksheet you are trying to run it from. If you need the same one to run from multiple sheets, you should put it into a module and call it from each sheet's Worksheet_Change method.
You can't press F5 or the run button to run triggered code. You would have to make a change in the sheet where this code is located in order for the code to run. Also, if this code is not located in Sheet90, then you won't see anything happen because this code only makes changes to Sheet90. Lastly, to make sure events are enabled, you can run this bit of code:
Sub ReEnable_Events()
Application.EnableEvents = True
End Sub
Note that you will still have to enable macros.
The problem stems from two lines:
Set ValidStr = Join(EmplList, ",")
was not a valid use of the Set keyword (It's a string and not an object), and
Set TestArea = Sheet90.Range("b4:q8", "b15:q19", "b26:q30")
apparently has too many arguments.
According to Microsoft, it should be a single string argument like:
Set TestArea = Sheet90.Range("b4:q8, b15:q19, b26:q30")
Commenting both of these out made the code run fine both with the run sub button, and on the event.
The "Name Macro" dialog is some kind of error indicator, but I still don't know what it means, other than Code Borked