This code feels like Schrodinger is executing it. If I open the project and run the code, I won't get any errors at all. If I view the code to edit or add anything, the first time I run the code, I get 'Run-time error 91'. If I try to run it a second time, making no changes, I get 'Run-time error 429' (ActiveX component can't create object).
What I'm trying to achieve is to find the row (BuildSel) in a range on worksheet (Ref) that has the same value as what's selected in a list on a userform (BuildList). Then once the row is found, to take data from that row and columns A and B, and put them in textbox's on my userform. Is my code right and ActiveX making the error? I apologize for terrible coding too.
EDIT: The listbox is on a multipage on my userform. I first noticed the issue today when I tried adding another listbox on a different page.
Private Sub BuildList_Click()
Dim Ref As Worksheet, BuildSel As Long
Set Ref = ThisWorkbook.Sheets("Ref")
BuildSel = Ref.Range("B2", Ref.Range("B" & Rows.Count).End(xlUp)).Find(BuildList.Value, lookat:=xlPart).Row
BuilderText.Value = Ref.Range("A" & BuildSel).Value
CompNameText.Value = Ref.Range("B" & BuildSel).Value
End Sub
Not sure why altering 'BuildSel' to variant makes it work, but the code as it stands has no error checking for when there is no matching list item to be found
The following code should be better suited for usage:
Private Sub BuildList_Click()
Dim Ref As Worksheet: Set Ref = ThisWorkbook.Sheets("Ref")
Dim BuildSel As Range
With Ref
Set BuildSel = .Range("B2", .Range("B" & Rows.Count).End(xlUp)).Find _
(BuildList.Value, lookat:=xlPart)
If Not BuildSel Is Nothing Then
BuilderText.Value = .Range("A" & BuildSel.Row).Value
CompNameText.Value = .Range("B" & BuildSel.Row).Value
Else
BuilderText.Value = ""
CompNameText.Value = ""
End If
End With
End Sub
Related
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.
I am writing code to create a template. This code populates a tab named "fullDistribution" from user-input on different tabs in the same wb. I have a working section of code that I wrote in a separate module (for testing) away from my master module. The code runs properly and executes completely when it is separate. When I pasted this section of code into my master module and ran it, I began receiving "Run-time error 91: object variable or with block variable not set" at the start of the newly-pasted code. I am not using any with blocks, and all of my variables are set. I made no changes in my code when I transferred it to my master module, and I carried over the new variables I created.
This is the selection of code that I wrote in a separate module:
Worksheets("bls2016").Activate
tcount = WorksheetFunction.CountA(Worksheets("detailedEntity").Range("D2:D" & Cells(Rows.Count, "D").End(xlUp).Row))
acount = WorksheetFunction.CountA(Worksheets("detailedEntity").Range("K2:K7"))
Application.ScreenUpdating = False
Dim h As Integer
Dim f As Integer
Dim blstate As Range
Dim bl As Range
Dim state As Range
Dim deat As Range
Dim agje As Range
Dim e As Integer
Dim r As Integer
Dim ii As Integer
Set blstate = Worksheets("bls2016").Range("D2:D" & Cells(Rows.Count, "D").End(xlUp).Row)
Set state = Worksheets("detailedEntity").Range("Q1")
Set deat = Worksheets("detailedEntity").Range("D2:D" & Cells(Rows.Count, "D").End(xlUp).Row)
Set agje = Worksheets("detailedEntity").Range("L2:M" & Cells(Rows.Count, "M").End(xlUp).Row)
h = Activecolumn
f = Activerow
r = 2
x = 120
For e = 1 To (acount * acount)
blstate.Find(state).Select
For ii = 1 To x
'ccnt = acst.Offset(0, 1)
ccgv = ActiveCell.Offset(0, 2)
acem = ActiveCell.Offset(0, 5)
Do While True
vl1 = Application.IfNa(Application.VLookup(Worksheets("fullDistribution").Cells(r, 2), deat, 1, False), 0)
If vl1 = 0 Then
Worksheets("fullDistribution").Cells(r, 4) = 0
Else:
vl2 = Application.IfNa(Application.VLookup(Worksheets("fullDistribution").Cells(r, 1), agje, 2, False), 0)
If ActiveCell.Offset(0, 1).Value = "Unknown Or Undefined" Then
Exit Do
Else:
If vl2 = ccgv Then
Worksheets("fullDistribution").Cells(r, 4) = acem
ElseIf vl2 <> ccgv Then
Worksheets("fullDistribution").Cells(r, 4) = ActiveCell.Offset(x + 1, 5)
Else:
End If
End If
End If
Exit Do
Loop
ActiveCell.Offset(f + 1, h).Select
r = r + 1
Next ii
Next e
The error triggers at the line "blstate.find(state).select" which tells excel to look in a dynamic range that contains the names of states and select the first instance of the state to use as the Activecell. Again, this works when it's run outside of the main module.
I believe this has something to do with a reference area. When this runs alone and finishes, I have to have a specific worksheet activated for it to run properly. If my excel workbook is open to a different tab, it will not run. My main module too only executes properly if it is run on a specific worksheet/tab.
If need be, I can edit my post and provide my whole master code.
It may be a problem of not fully referencing sheets, eg amend your blstate line to
with Worksheets("bls2016")
Set blstate = .Range("D2:D" & .Cells(.Rows.Count, "D").End(xlUp).Row)
end with
Then it might find the value and not error. You should look up how to use the Find method as your way is destined to cause you headaches.
blstate.Find(state).Select
Your code assumes that .Find finds what it's looking for. When Find doesn't find what it's looking for, the function returns Nothing, which is essentially a null object reference - and you can't make member calls on Nothing without getting run-time error 91.
Split it up:
Dim result As Range
Set result = blstate.Find(state)
If Not result Is Nothing Then
result.Select 'questionable anyway, but that's another issue
Else
MsgBox "Value '" & state & "' was not found in " & blstate.Address(External:=True) & "."
Exit Sub
End If
As for why it's not finding what you're looking for, Tim Williams already answered that:
Find recalls all settings used in the last call (even if you use the GUI to perform the Find), so make sure you specify the settings you want when you call it via VBA. If you don't do that, it may not work as you expect.... – Tim Williams 42 mins ago
My issue was very much related to incorrect referencing, however, I was able to resolve this issue by keeping the specific piece of code I was testing in a separate sub, and calling it from my main code, 'full distribution'.
Call test
'test' is the name of the sub with the tested code. This is a temporary fix to the solution, and if anyone struggles with referencing, try this.
Trying to hammer out bugs in my code. Currently trying to do some very simple, open worksheet, copy and paste data over. Trying to do it all without using .Select or .Activate. Hitting "Application-defined or Object defined error", which, from reading the other threads on the matter, probably means that my statements aren't fully qualified. However, I can't figure out how they're not fully qualified - other posts on the topic seem to be missing a "." somewhere in the code, but my attempts to fix it haven't gotten anywhere. Heavily truncated code as follows (If you don't see it dimmed/defined, it's elsewhere)
Sub CopyPaste()
Dim CitiReportEUR As Workbook
Dim CitiReportPathEUR As String
CitiReportPathEUR = Range("CitiReportPathEUR")
Workbooks.Open Filename:=CitiReportPathEUR
Set CitiReportEUR = ActiveWorkbook
LastRowCiti = CitiReportEUR.Sheets(1).Range("I" & Rows.Count).End(xlUp).Row
Set RngCitiEUR = CitiReportEUR.Sheets(1).Range("A1:CT" & LastRowCiti).SpecialCells(xlCellTypeVisible)
Set CabReport.Sheets("CITI").Range("C1").Resize(RngCitiEUR.Rows.Count).Value = RngCitiEUR.Value
End Sub
Currently the error is occurring when I define the range. I've had problems historically with pasting into the range as well... but that's an issue for when I can actually get the code to run that far!
Rows.Count is implicitly working with the ActiveSheet.
The use of Set when assigning values to the Value property of a Range is inappropriate. Set should only be used when assigning a reference to an object.
The Resize probably needs to cater for the number of columns in the source as well as rows.
This code is more explicit:
Sub CopyPaste()
Dim CitiReportEUR As Workbook
Dim CitiReportPathEUR As String
CitiReportPathEUR = Range("CitiReportPathEUR")
Set CitiReportEUR = Workbooks.Open(Filename:=CitiReportPathEUR)
With CitiReportEUR.Sheets(1)
LastRowCiti = .Range("I" & .Rows.Count).End(xlUp).Row
Set RngCitiEUR = .Range("A1:CT" & LastRowCiti).SpecialCells(xlCellTypeVisible)
End With
CabReport.Sheets("CITI").Range("C1").Resize(RngCitiEUR.Rows.Count, RngCitiEUR.Columns.Count).Value = RngCitiEUR.Value
End Sub
I am working with Excel 2016. I have a smidgen of experience with VBA for applications, and some experience with programming.
I'm trying to take input from a barcode scanner, compare it to a column in a spreadsheet, and if there's a match, put a few characters and a date stamp in some cells (Initials and date, each in separate columns).
This question has a very similar use-case, and includes a code sample. I have tried the code sample and can't get it to work. At first, there was a problem with the array. Eventually I figured out you could do "C2:C8" and that seemed to work, though that's not documented anywhere (Probably part of a basics course/class, but not findable). There was an error about sub or function defined for Match(), so I enabled the Solver Add-in in the security center. That didn't fix it, so I found this forum post that explained Match wasn't a VBA function.
Now, I get an error after clicking the button "Run time error 1004, unable to get Match property of the WorksheetFunction class", clicking debug takes me to the same line.
Here is the code I have wound up with:
Private Sub CommandButton1_Click()
code = InputBox("Please scan a barcode and hit enter if you need to")
matchedCell = Application.WorksheetFunction.Match(code, Range("C2:C8"), 0)
matchedCell.Offset(0, 2) = Now
End Sub
This is incredibly frustrating because I thought this was a simple thing and already solved. Instead of working to solve the problem and build software, it seems I'm fighting syntax and/or the environment. What am I doing wrong?
two possibilities:
use Match() function of Application object
and store its returned value in a Variant variable to be checked for any error (if value not found)
Private Sub CommandButton1_Click()
Dim code As Variant
Dim matchedCell As Variant
code = InputBox("Please scan a barcode and hit enter if you need to")
matchedCell = Application.Match(code, Range("C2:C8"), 0)
If Not IsError(matchedCell) Then Range("C2:C8").Cells(matchedCell, 1).Offset(0, 2).Value = Now
End Sub
use Find() function of Range object
Private Sub CommandButton1_Click()
Dim code As Variant
Dim matchedCell As Range
code = InputBox("Please scan a barcode and hit enter if you need to")
Set matchedCell = Range("C2:C8").Find(what:=code, LookIn:=xlValues, lookat:=xlWhole, MatchCase:=True)
If Not matchedCell Is Nothing Then matchedCell.Offset(0, 2).Value = Now
End Sub
Use Application.Match , and continue running your code only if there is a successful Match.
Option Explicit
Private Sub CommandButton1_Click()
Dim MatchRow As Variant
Dim code As Variant
Dim matchedCell As Range
code = InputBox("Please scan a barcode and hit enter if you need to")
' verify that there is a successful match in the searched range
If Not IsError(Application.Match(code, Range("C2:C8"), 0)) Then
MatchRow = Application.Match(code, Range("C2:C8"), 0) '<-- get the row number
Set matchedCell = Range("C" & MatchRow + 1) '<-- set the range (add 1 row since you are starting from row 2)
matchedCell.Offset(0, 2).Value = Now
'option 2: without setting the range
Range("C" & MatchRow).Offset(1, 2).Value = Now
End If
End Sub