I have been getting a large number of answers from Stackoverflow and I really appreciate all of the information you experts have provided! This is my first time asking a question - so thank you.
I am running various VBA programs in the backend of a large Excel 2010 workbook and I am completely stumped on my current issue. In a Module, I have a public sub with a For Each loop that iterates through a variant which is loaded with a range of string values in a worksheet.
When I run this loop, I either get an immediate compile error "Variable not defined" and the for each variable is highlighted or the program runs but loops without end. I have literally commented everything out in the loop itself and I still get this issue. When the loop does run, I see the string value being correctly retrieved into the for each variable. If I comment out the loop then the sub runs without any issues.
Here is what I have to be clear:
Dim showWord as String
showWord = ""
For Each thisWord In allWords
'showWord = CStr(thisWord)
'MsgBox showWord
Next x
Now I have this exact same loop elsewhere in a different module and it always runs without issue. I did change both the for each variable and variant variable names but that was it.
Can somebody please help me figure out what is going on here?
Thank you.
your loop doesn't end because in Next x must be the same variable you are looping, something like this Next ThisWord and you must declare allWords.
Dim showWord as String
showWord = ""
For Each thisWord In allWords
....
Next thisWord
Pretty sure you didn't define your variable allWords, as follow
Dim showWord as String
showWord = ""
dim allWords as (wtv)
allWords = (something)
'if not allWords is nothing then
For Each thisWord In allWords
'showWord = CStr(thisWord)
'MsgBox showWord
Next x
'end if
Related
I hope my first post will be OK and not offend (I've tried to follow the guide and done a lot of searching).
I've modified the below code from Greg Maxey (https://gregmaxey.com/word_tip_pages/word_fields.html) to update links in my Word document to an Excel workbook. It seems to be the most used code for this purpose. The reason I changed his code was to try to do away with the need to have a counter variable like i, and using a For i = 1 to .Fields.Count Then... Next i structure.
When I run it as is, it gets stuck in a loop only updating the first field in the Word document. To see this, I put in the Debug.Print wrdField.Index line. It repeatedly outputs 1, so it is not moving to the Next wrdField as I expect (the code actually just used Next, but it's the same result if I use Next wrdField).
When I comment out .AutoUpdate = False, it works properly:
Public Sub UpdateExternalLinksToCurrentFolder()
Dim wrdDocument As Word.Document
Dim wrdField As Word.Field
Dim strCurrentLinkedWorkbookPath, strNewLinkedWorkbookPath As String
Dim strCurrentLinkedWorkbookName, strNewLinkedWorkbookName As String
Dim strCurrentLinkedWorkbookFullName, strNewLinkedWorkbookFullName As String
Dim strThisDocumentPath As String
'On Error GoTo ErrorHandler_UpdateExternalLinksToCurrentFolder
Application.ScreenUpdating = False
Set wrdDocument = ActiveDocument
strThisDocumentPath = wrdDocument.Path & Application.PathSeparator
strNewLinkedWorkbookPath = strThisDocumentPath
With wrdDocument
For Each wrdField In .Fields
With wrdField
If .Type = wdFieldLink Then
With .LinkFormat
Debug.Print wrdField.Index
strCurrentLinkedWorkbookPath = .SourcePath & Application.PathSeparator
strCurrentLinkedWorkbookName = .SourceName
strNewLinkedWorkbookName = strCurrentLinkedWorkbookName
strNewLinkedWorkbookFullName = strNewLinkedWorkbookPath & strNewLinkedWorkbookName
.AutoUpdate = False
End With
.Code.Text = VBA.Replace(.Code.Text, Replace(strCurrentLinkedWorkbookPath, "\", "\\"), Replace(strNewLinkedWorkbookPath, "\", "\\"))
End If
End With
Next
End With
Set wrdDocument = Nothing
Application.ScreenUpdating = True
Exit Sub
Can anyone tell my why it's behaving this way? When I set .AutoUpdate = False, am I changing something about the link field or doing something to the Word document that causes the .wrdField.Index to reset to 1? I can't find anything online documenting this behavior and it's driving me nuts.
Behind the scenes, what's happening is that Word recreates the content and the field. The orginal linked content is removed and new content inserted. So that essentially destroys the field and recreates it. A user won't notice this, but VBA does.
When dealing with a loop situation that uses an index and the looped items are being removed, it's therefore customary to loop backwards (from the end of the document to the beginning). Which cannot be done with For...Each.
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
Hi please can someone help, Excel 2016 VBA PivotTable objects. I rarely develop in Excel VBA.
Overall goal:
Compare a single column [P_ID] value list from PivotTable2 against PivotTable1 if they exist or not to enable filtering on those valid values in PivotTable1.
I have some Excel 2016 VBA code which I have adapted from a previous answer from a different internet source.
Logic is: gather data from PivotTable2 from the ComparisonTable dataset (in PowerPivot model), field [P_ID] list of values. Generate a test line as input into function to test for existence of field and value in PivotTable1 against the Mastertable dataset, if true add the line as valid if not skip the line.
Finally filter PivotTable1 with the VALID P_ID values.
It works to a point until it gets to the bFieldItemExists function which generates an error:
Run-time error '1004'
Unable to get the PivotItems property of the PivotField class
Can someone please correct the way of this not working?
Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
Dim MyArray As Variant, _
ar As Variant, _
x As String, _
y As String, _
str As Variant
MyArray = ActiveSheet.PivotTables("PivotTable2").PivotFields("[ComparisonTable].[P_ID].[P_ID]").DataRange
For Each ar In MyArray
x = "[MasterTable].[P_ID].&[" & ar & "]"
If ar <> "" And bFieldItemExists(x) = True Then
If str = "" Then
str = "[MasterTable].[P_ID].&[" & ar & "]"
Else
str = str & "," & "[MasterTable].[P_ID].&[" & ar & "]"
End If
End If
Next ar
Dim str2() As String
str2 = Split(str, ",")
Application.EnableEvents = False
Application.ScreenUpdating = False
ActiveSheet.PivotTables("PivotTable1").PivotFields("[MasterTable].[P_ID].[P_ID]").VisibleItemsList = Array(str2)
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Function bFieldItemExists(strName As String) As Boolean
Dim strTemp As Variant
' This line does not work!?
strTemp = ActiveSheet.PivotTables("PivotTable1").PivotFields("[MasterTable].[P_ID].[P_ID]").PivotItems(strName)
If Err = 0 Then bFieldItemExists = True Else bFieldItemExists = False
End Function
The 1004 error occurred due to the use of square brackets [ ]. Remove those.
You also need to use the key word Set when you set an object equal to something. For example Set MyArray = ActiveSheet.PivotTables("PivotTable2").PivotFields("ComparisonTable.P_ID.[P_ID").DataRange.
If you don't use Set you will get a VBA run-time error dialog that says Run-time error '91': Object variable or With block variable not set
I cannot guarantee that my edits will completely solve your problem since I don't have your data set and cannot fully test your code. You will need to use the Debug mode in the VBA editor and single step through the code. To this set a breakpoint on the Set mDataRange = Active.... To set a breakpoint go to the Debug menu and choose the "Toggle Breakpoint" sub-menu item or you can press F9 to set the breakpoint.
Now when you make a change to the Pivot table, the Worksheet_PivotTableUpdate event will fire and the code will top execution at that point.
After the code stops executing due to the breakpoint, you can press the F8 key to single step through your code. If you want to resume execution to the next breakpoint you can press F5. Also when you get the VBA error dialog box, you can hit Debug and then use the F8 key to single step or use the debug windows to see what your variables and objects contain. I'm sure there are some good youtube videos on VBA debugging.
As you single step through the code, you can observe what each variable/object contains using the Immediate window, the Watches window and the Locals window. To open these windows, go to the menu item View and click on each of these sub-menu items.
Here's how you need to edit your code before debugging.
Option Explicit
Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
'Better practice is to not use the underscore character to
'continue a Dim declaration line
Dim mDataRange As Range
Dim ar As Range
Dim x As String
Dim y As String
Dim str As Variant
'Use Set to assign the object mDataRange a reference to the the right
'hand side of the equation. Remove the square brackets
'MyArray = ActiveSheet.PivotTables("PivotTable2").PivotFields("[ComparisonTable].[P_ID].[P_ID]").DataRange
Set mDataRange = ActiveSheet.PivotTables("PivotTable2").PivotFields("ComparisonTable.P_ID.P_ID").DataRange
For Each ar In mDataRange
'You need to specify what proprerty from ar you
'want to assign to x. Assuming the value stored in
'ar.Value2 is a string, this should work.
'We use value2 because it is the unformmated value
'and is slightly quicker to access than the Text or Value
'properties
'x = "[MasterTable].[P_ID].&[" & ar & "]"
x = "MasterTable.P_ID." & ar.Value2
'Once again specify the Value2 property as containing
'what value you want to test
If ar.Value2 <> "" And bFieldItemExists(x) = True Then
If str = "" Then
'Remove the square brackets and use the specific property
'str = "[MasterTable].[P_ID].&[" & ar & "]"
str = "MasterTable.P_ID." & ar.Value2
Else
'Remove the square brackets and use the specific property
'str = str & "," & "[MasterTable].[P_ID].&[" & ar & "]"
str = str & "," & "MasterTable.P_ID." & ar.Value2
End If
End If
Next ar
Dim str2() As String
str2 = Split(str, ",")
Application.EnableEvents = False
Application.ScreenUpdating = False
'Remove square brackets
'ActiveSheet.PivotTables("PivotTable1").PivotFields("[MasterTable].[P_ID].[P_ID]").VisibleItemsList = Array(str2)
ActiveSheet.PivotTables("PivotTable1").PivotFields("MasterTable.P_ID.P_ID").VisibleItemsList = Array(str2)
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Function bFieldItemExists(strName As String) As Boolean
'Declare a PivotItem to accept the return value
Dim pvItem As PivotItem
'Since you want to trap for an error, you'll need to let the VBA runtime know
'The following code is a pseudo Try/Catch. This tells the VBA runtime to skip
'the fact an error occured and continue on to the next statement.
'Your next statement should deal with the error condition
On Error Resume Next
'Use Set whenever assigning an object it's "value" or reference in reality
Set pvItem = ActiveSheet.PivotTables("PivotTable1").PivotFields("MasterTable.P_ID.P_ID").PivotItems(strName)
'Assuming that an error gets thrown when strName is not found in the pivot
'Err is the error object. You should access the property you wish to test
If Err.Number = 0 Then
bFieldItemExists = True
Else
bFieldItemExists = False
End If
'Return to normal error functioning
On Error GoTo 0
End Function
Finally, I realize that some of this should be in the comments section, but there was too much I needed to explain to help Learner74. BUT most importantly, I hope I helped him. I have used so many suggestions, recommendations and explanations from the VBA Stack Overflow exchange through the years, I just want to pay it back by paying it forward.
Additional USEFUL Links:
Chip Pearson is the go to site and person for all things VBA
Paul Kelly's Excel Macro Mastery is another go to site for Excel and VBA questions.
Microsoft Excel Object Model which is sometimes useful, but needs improvement. Too many of the objects lack examples, but can at least point you in the right direction.
This one has me really stymied and I suspect it because I am now too "close" to the problem. I am converting a VB.NET routine into a VBA routine. Here is the VB.NET code that works as expected.`
Dim rows() As Object
BOM.GetRows(rows)
Dim row As IEdmBomCell
For Each row In rows
If IsNothing(row) Then Exit For
Dim rowString As String = row.GetTreeLevel.ToString & vbTab
Dim varVal As String = ""
For Each column As EdmBomColumn In columns
row.GetVar(column.mlVariableID, column.meType, varVal, Nothing, Nothing, Nothing)
If IsNothing(varVal) Then varVal = ""
rowString = rowString & varVal & vbTab
Next
'-----------------------------WRITE THE ROW TO THE FILE
sw.writeline(rowString)
Next`
The VBA code I have looks like this:
Dim varVal As String
Dim rows() As Variant
Dim row As IEdmBomCell
Dim rowstring As String
Call BOM.GetRows(rows)
For p = 0 To UBound(rows)
Set row = rows(p)
If IsEmpty(row) Then Exit For
rowstring = row.GetTreeLevel & vbTab
varVal = ""
For i = 0 To UBound(columns)
column = columns(i)
Call row.GetVar(column.mlColumnID, column.meType, varVal, Nothing, "", True)
rowstring = rowstring & varVal & vbTab
Debug.Print rowstring
Next
'-----------------------------WRITE THE ROW TO THE FILE
sw.writeline (rowstring)
Next
Where I am getting the failure is line Call row.GetVar(column.mlColumnID, column.meType, varVal, Nothing, "", True).
The varVal variable never returns a value, yet the code is stepping through each column data set.
The VBA watch window for all the variables being worked on.
I would like to place the blame on the row.GetVar call being broken, but the .NET code works just fine (on the same machine as the VBA). I just must have a bad assignment somewhere. Again, the code does not fail to run or generate any errors it just never creates the output expected, which looks like this:
Expected Output:
VS. this is this result:
Results of current code:
A bit late to the party but I ran into that issue as well. I've got it working in VBA using a Variant instead of a String variable.
So instead of
Dim varVal As String
try
Dim varVal As Variant
After a bit more digging around the API documentation, I am now fairly confident that the problem is in fact VBA itself.
This information has been in the SolidWorks API documentation for a few versions now. It seems they recommend against using VBA in SolidWorks API applications, and confirm that using VBA may result in unexpected behavior.
I already linked this in my comment, but for completeness sake, here is the first place in the release notes they confirm VBA (VB6) is not supported.
I've had issues with using the PDM API from VBA before and what I needed to do was create a COM wrapper to expose what I needed.
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.