I have an Excel VBA UserForm Combobox for scanning asset tags to compare against a site baseline held in Sheet1. There can be upto 50,000+ assets. The named ranges are all correct.
I want the loop to fill the "Found" Asset attribute Textboxes for Type, Serial, MakeModel, Location & PrinterHost.
The code is below without the additional index match lookups for extra asset attributes as the process will be the same. Help appreciated as I'm not sure where I'm going wrong. Thanks in advance.
Private Sub ComboScanTag_Change()
Dim x As Integer
Dim AssetCount As Long
Dim BASELINE As Range
Dim AssetID As Range
Dim FoundType As Variant
Dim FoundSerial As Variant
Dim FoundMakeModel As Variant
Dim FoundLocation As Variant
Dim FoundPrinterHostName As Variant
If Me.ComboScanTag.Value = "" Then 'ScanTag has no value
MsgBox "Asset not Found - Re-Scan or enter New Asset details"
Me.ComboScanTag.SetFocus
End If
If Me.ComboScanTag.Value <> "" Then 'ScanTag has a value
Application.ScreenUpdating = False 'Turn off screen updating to speed app
For x = 1 To AssetCount 'Number of loop iterations from Baseline Assets Count D1 cell
FoundType = Application.Index("BASELINE", Application.Match(Me.ComboScanTag.Value, "AssetID", False), 3)
If Not IsError(FoundType) = False Then 'if error value in lookup return 0
Me.txtFoundType.Value = FoundType 'Fill textbox FoundType with lookup value from baseline
Else
On Error GoTo 0 'reset error handler
FoundSerial = Application.Index("BASELINE", Application.Match(Me.ComboScanTag.Value, "AssetID", False), 11)
If Not IsError(FoundSerial) = False Then
Me.txtFoundSerial.Value = FoundSerial
End If
Next x
End If
Application.ScreenUpdating = True
End Sub
AssetCount is not initialized. You need to initialize it before you use it like AssetCount = 10.
BASELINE and AssetID are not set as well.
If BASELINE and AssetID are named ranges, you cannot use it the way you do in Application.Index or Application.Match.
You need to pass it as object and not as string like this:
Set BASELINE = ThisWorkbook.Names("BASELINE").RefersToRange
Set AssetID = ThisWorkbook.Names("AssetID").RefersToRange
Then you can use it like this in Application.Index and Match:
With Application
FoundType = .Index(BASELINE, .Match(Me.ComboScanTag.Value, AssetID, False), 3)
End With
Related
I'm trying to write a macro that allows a user to enter a new banknote serial number. The macro requires 3 inputs (currency, denomination and serial number). I'm a beginner to VBA, but the code I tried to write is below. Can anyone point out where I went wrong, or what needs to be changed to make it work? Thanks!
Sub TestSub()
Dim Note_Serial As Variant
Dim Note_Currency As Variant
Dim Note_Denomination As Variant
'Defining 3 inputs
Note_Currency = InputBox("Enter Currency (in 3 letter form):")
Note_Denomination = InputBox("Enter Note Denomination (with $ sign):")
Note_Serial = InputBox("Enter Serial Number:")
'Getting 3 inputs
Dim Currency_Cell As Range
Dim Denomination_Cell As Range
Dim Serial_Cell As Range
'Defining cells to write inputs
Currency_Cell = (D3)
Denomination_Cell = (E3)
Serial_Cell = (F3)
'Starting cells
Currency_Cell = Note_Currency
Denomination_Cell = Note_Denomination
Serial_Cell = Note_Serial
'Writing inputs to spreadsheet
Currency_Cell.Offset (1)
Denomination_Cell.Offset (1)
Serial_Cell.Offset (1)
'Moving all cells down 1 place
End Sub
Instead of writing Currency_Cell = (D3), you want to write Set Currency_Cell = Range("D3") (Assuming that you don't switch the active Worksheet).
EDIT: To prevent overwriting previously entered data, use instead:
Set Currency_Cell = Cells(Rows.Count, Range("D3").Column).End(xlUp).Offset(1, 0)
This will select the first empty Cell in Column D.
To move the cell reference, you have to also use the Set keyword, and give the offset in rows and columns:
Set Currency_Cell = Currency_Cell.Offset (1, 0)
I have a slicer called 'Slicer_HeaderTitle'. I simply need to be able to dim a variable in VBA with the value of the selected element. I'll only have one element selected at a time.
I've had a lot of problems with selecting and de-selecting elements from my slicer dynamically via VBA, since my pivot table is connected to an external data-source. I don't know if this is relevant for this exact example, but this table is connected to the same external data-source.
I used to have a single line of code, which could return this value, but all i could find now requires you loop through each element in the slicer and check if it's selected or not. I hope to avoid this, since I only have 1 selected element at a time.
' This is what I'm trying to achieve.
Dim sValue as String
sValue = ActiveWorkbook.SlicerCaches("Slicer_HeaderTitle").VisibleSlicerItems.Value
msgbox(sValue)
'Returns: "Uge 14 - 2016 (3. Apr - 9. Apr)"
Current Status:
This is what i did:
Public Function GetSelectedSlicerItems(SlicerName As String) As String
Dim SL As SlicerCacheLevel
Dim sI As SlicerItem
Set SL = ActiveWorkbook.SlicerCaches(SlicerName).SlicerCacheLevels(1)
For Each sI In SL.SlicerItems
If sI.Selected = True Then
GetSelectedSlicerItems = (sI.Value)
End If
Next
End Function
Dim sValue As String
sValue = GetSelectedSlicerItems("Slicer_HeaderTitle")
Thanks to Doktor OSwaldo for helping me a lot!
Ok to find the error, we will take a step back, delete my function and try Looping through the items:
Dim sC As SlicerCache
Dim SL As SlicerCacheLevel
Dim sI As SlicerItem
Set sC = ActiveWorkbook.SlicerCaches("Slicer_Dates_Hie")
Set SL = sC.SlicerCacheLevels(1)
For Each sI In SL.SlicerItems
sC.VisibleSlicerItemsList = Array(sI.Name)
Next
I would like to put in my two cents. The set of visible slicer items may be shrunk by both independent actions:
User selection of items in slicer A. To capture those items, use .Selected method.
Selection of items in slicer B which in consequence shrinks the list of slicer A items. To capture those items, use .HasData method.
Note that you may see only say two items of Slicer_Products (apples, bananas) because some other slicer Slicer_Product_Type has active filter on fruits. The method sI.Selected would still return the whole list of products apples, bananas, carrots...
If you want both limitations to be in place then make intersection of both sets. I have modified TobiasKnudsen code (excellent answer!) to return the list of items shrunk by both above limitations. If sI.Selected = True And sI.HasData = True Then is the key line in this code.
Option Explicit
Sub TestExample()
Dim MyArr() As Variant
MyArr = ArrayListOfSelectedAndVisibleSlicerItems("Slicer_A")
'now variable MyArr keeps all items in an array
End Sub
Public Function ArrayListOfSelectedAndVisibleSlicerItems(MySlicerName As String) As Variant
'This function returns an array of the limited set of items in Slicer A
'Limitation is due to both:
'(1) direct selection of items by user in slicer A
'(2) selection of items in slicer B which in consequence limits the number of items in slicer A
Dim ShortList() As Variant
Dim i As Integer: i = 0 'for iterate
Dim sC As SlicerCache
Dim sI As SlicerItem 'for iterate
Set sC = ThisWorkbook.Application.ActiveWorkbook.SlicerCaches(MySlicerName)
For Each sI In sC.SlicerItems
If sI.Selected = True And sI.HasData = True Then 'Here is the condition!!!
'Debug.Print sI.Name
ReDim Preserve ShortList(i)
ShortList(i) = sI.Value
i = i + 1
End If
Next sI
ArrayListOfSelectedAndVisibleSlicerItems = ShortList
End Function
Sub Demo()
Dim i As Integer
With ActiveWorkbook.SlicerCaches("Slicer_Country")
For i = 1 To .SlicerItems.Count
If .SlicerItems(i).Selected Then
Sheets("Pivot Sheet").Range("I" & i) = SlicerSelections & " " & .SlicerItems(i).Value
End If
Next i
End With
End sub
This is how I managed to identify the selected element on a slicer.
The answer by TobiasKnudsen above did not work for me as I got an error stating the data source needed to be an OLAP source.
My data is an excel table and this is the code that worked:
Dim val as Boolean
val = ThisWorkbook.SlicerCaches("Slicer_MYSLICER").VisibleSlicerItems.Item("CS").HasData
In my case, the slicer had only 3 items so I repeated the line above with a different string in item()
So, where val was true, that was the item that was currently selected.
Context:
I have several lists in my sheet (1 column wide, 1-10 rows long). When I right click a cell in these lists, I can do several options, that all work well. I have given a name to the cell at the top of each of these lists (ex. Cell A1 has been given the name cell_1, B10 is names cell_2, etc).
I would like to know if the cell I am right clicking on is the one at the top of the list; is it named "cell_(number)"? If it is not, it checks the cell on top of that one. Does it have a name that starts with "cell_"? If not, check the one on top, etc. Until I can figure out the user clicked on an element of WHICH list.
TL;DR The actual question
I can use ActiveCell.Address, which gives me something like "A1" whether or not I have assigned a name to that cell. ActiveCell.Name gives "Sheet1!A1", so it's not much better. Any idea how to get it to return the name I have assigned instead?
Create a UDF to test the application names, it's less efficient but contains error handling within the function itself:
Sub SO()
'// Example how to call function
Debug.Print GetCellName(Range("A1"))
End Sub
Function GetCellName(myCell As Excel.Range) As Variant
Dim nameCheck As Variant
For Each nameCheck In Application.Names
If Replace(Replace(Replace(nameCheck, "=", ""), "'", ""), "!", "") = _
CStr(myCell.Parent.Name & myCell.Address) Then
GetCellName = CStr(nameCheck.Name)
Exit Function
End If
Next
GetCellName = CVErr(Excel.xlErrName)
End Function
Note you can also use this function in a worksheet cell like so:
=GetCellName(A1)
Perhaps this would work. This function returns the names assigned to a cell (or bigger range for that matter). If there's more than one name, it returns it as an array for array formula...or the user can supply an index to return only the desired name position
Public Function CellIsInRangeNames(sheetname As String, checkRange As Range, Optional itemNumber As Variant) As Variant
Dim oNM As Name
Dim oSht As Worksheet
Dim isect As Range
Dim namesCollection() As Variant
Set oSht = Worksheets(sheetname)
Dim i As Integer
i = -1
For Each oNM In oSht.Names
Set isect = Application.Intersect(Range(oNM.Name), checkRange)
If Not isect Is Nothing Then
i = i + 1
ReDim Preserve namesCollection(0 To i)
namesCollection(i) = CStr(oNM.Name)
End If
Next oNM
If i = -1 Then
'didn't find any
CellIsInRangeNames = xlErrName
ElseIf Not IsMissing(itemNumber) Then
'user wanted this instance only
If (itemNumber - 1 > UBound(namesCollection)) Or (itemNumber - 1 < LBound(namesCollection)) Then
CellIsInRangeNames = xlErrValue
Else
CellIsInRangeNames = namesCollection(itemNumber - 1)
End If
Else 'here's the list as an array
CellIsInRangeNames = namesCollection
End If
End Function
I have the following code below that iterates through rows of a specific range and if a value is present (code not seen), creates copies of the entire pages. My concern is at the bottom of the code in the iteration of r1. It originally only had one conditional statement...
If BiDiRowValid(r1)
and I wanted to add a second conditional statement, which I did...
and Range("MAIN_BIDI_PINMC") <> "No BiDi"
but when I run the code and the MAIN_BIDI_PINMC range = "No BiDi", it errors out and doesn't get past that line. FYI: IsBiDiRowValid() is a function that checks to see that the specific r1 is not empty, and then continues. Right after that subroutine finishes and exits, my code errors with a "Type Mismatch error". I also added the ElseIf line at the bottom, I have not gotten to that code because the top errors out, but I just want to make sure I am writing this iteration correctly, and if anything else needs to be done. Basically, if "NoBiDi" is found in the range, I want it to skip all of this code and go to the next r1... which is what I think I have written... Thanks in advance!
Private Sub start_new()
Dim MC_List As Range
Dim r1 As Range
Dim biDiPinName As Range
Dim Pin As String
Dim mc As String
Dim mType As String
Dim tabName As String
Dim rowNumber As Integer
Dim pinmcSplit() As String
Dim NoBidi As String
On Error GoTo start_biDi_tr_new_Error
Set MC_List = Range("MAIN_PINMC_TABLE")
Set biDiPinName = Range("MAIN_PIN2_NAME")
For Each r1 In MC_List.Rows
If IsBiDiRowValid(r1) And WorksheetFunction.CountIf(Worksheets("MAIN").Range("MAIN_BIDI_PINMC", "No Bidi") = 0 Then
tabName = r1.Cells(1, 8)
pinmcSplit = Split(tabName, "_")
Pin = pinmcSplit(0)
mc = pinmcSplit(1)
mType = r1.Cells(1, 3)
ElseIf WorksheetFunction.CountIf(Worksheets("MAIN").Range("MAIN_BIDI_PINMC"), "No Bidi") = 1 Then
End If
Next
You are getting that error because Range("MAIN_BIDI_PINMC") is not a single cell. To check for a value in multiple cells you can use Application.Worksheetfunction.Countif
EDIT
Post discussion in chat, the user wanted to loop through each cell.
Dim aCell As Range
For Each r1 In MC_List.Rows
If IsBiDiRowValid(r1) Then
For Each aCell In Worksheets("MAIN").Range("MAIN_BIDI_PINMC")
If aCell.Value <> "No Bidi" Then
tabName = r1.Cells(1, 8)
pinmcSplit = Split(tabName, "_")
Pin = pinmcSplit(0)
mc = pinmcSplit(1)
mType = r1.Cells(1, 3)
End If
Next
ElseIf aCell.Value = "No Bidi" Then
'~~> Do Something
End If
Next
I have been trying to write a small piece of code to validate to confirm whether or not a date is included in an array. I have been able to scroll through the code until I reach the line If lists(i) = TodaysDate Then when the lists(i) show subscript out of range. I have searched through the Internet and I'm unable to resolve this issue.
My Macro reads as follows:
Sub size_an_array()
Dim i As Integer
Dim Range_of_Dates As Integer
Dim TodaysDate As Variant, finish As String
TodaysDate = Range("Sheet11!c2")
ThisWorkbook.Worksheets("Sheet11").Activate
lists = Range("Processed_Dates")
Range_of_Dates = UBound(lists, 1) - LBound(lists, 1) + 1
For c = 1 To UBound(lists, 1) ' First array dimension is rows.
For R = 1 To UBound(lists, 2) ' Second array dimension is columns.
Debug.Print lists(c, R)
Next R
Next c
x = Range_of_Dates 'UBound(lists, 1)
ReDim lists(x, 1)
i = 1
Do Until i = x
If lists(i) = TodaysDate Then
Exit Do
End If
Loop
MsgBox "The date has not been found"
End Sub
I'm relatively new to VBA and I have been trying to use named ranges to pull in the array but I'm completely at my wits end in trying to solve this piece.
Any help would be greatly appreciated.
You have ReDimmed the array lists from a one dimensioned array to a two dimensioned array and you are then trying to reference an element using only one dimension in the suspect line (below), which is causing your error.
If lists(i) = TodaysDate Then
For reference, Run-time error 9: Subscript out of range means you are referencing a non-existent array element.
I think this is what you are trying?
Sub size_an_array()
Dim i As Integer
Dim TodaysDate As Variant, lists
Dim bFound As Boolean
'~~> Change SomeWorksheet to the relevant sheet
TodaysDate = Sheets("SomeWorksheet").Range("c2")
lists = Sheets("Sheet11").Range("Processed_Dates")
i = 1
Do Until i = UBound(lists)
If lists(i, 1) = TodaysDate Then
bFound = True
Exit Do
End If
i = i + 1
Loop
If bFound = True Then
MsgBox "The date has been found"
Else
MsgBox "The date has not been found"
End If
End Sub
If I understand you correctly then it is much easier to use .Find. If you are interested then have a look at this link.