Matching and Placing Values from Another Table - vba

I'm trying to develop a check box switch on a form that auto-fills a check mark when the correct value is selected.
Item
Group
Category
Keyboard
Medium
Electronics
Laptop
High
Electronics
Mouse Pad
Low
Electronics
Apple
Low
Food
Wine
High
Food
Milk
Medium
Food
Goal:
I have a listbox that allows multiple selection of items, given a certain criteria "Category". The list automatically updates based on the category selected. Once selected, I want to see if the item selected falls under a certain "Group", either low, medium, or high.
Current Code:
' Create Array for multiple selection box
Dim ct As Integer, v, ArrCT()
ReDim ArrCT(ct = 0 To Me.testbutton.ItemsSelected.Count - 1)
For Each v In Me.testbutton.ItemsSelected
ArrCT(ct) = Me.testbutton.ItemData(v)
ct = 1 + ct
Next v
' Load table for matching
Dim db As Database
Dim rs As Recordset
Set db = CurrentDb
Set rs = db.OpenRecordset("MasterList")
Dim qmct As Integer, x, NewArr()
ReDim NewArr(qmct = 0 to Me.testbutton.ItemsSelected.Count - 1)
For Each x In Me.testbutton.ItemsSelected
NewArr(qmct) = ArrCT(x)
If NewArr(qmct) = rs![Item] Then
NewArr(qmct) = rs![Group]
End If
qmct = 1 + qmct
Next x
My idea was to create a temporary array which stores the selection, and then have a second for-loop go through the array to match the correct "group".
With the second array, despite triple checking the field name, I get:
Run-time error '3265':
Item not found in this collection.
Item information is loaded in the ArrCT array, and adjusts based on the number of selection.
Is there an easier way to call for a value in the table?
*Note: sample table is not my actual data, that has approximately 20 times more items, category and grouping.

Related

Generate Records to Add to Table - Loop or Recordset? [duplicate]

Where I work we receive electronic meters from customers and try to solve the errors they have. We will receive 4-8 meters at a time that all have the same problem, same specs, same everything, the only thing different between each meter is the Serial Number. I want to be able to enter every serial number, and the common specs all in one form to create multiple records.
Here's a pic of what I have for the form. I was able to create records for just one serial number at a time, but I would like to do it all at once to make data entry quicker and easier.
Meter Entry Form
So summary, Multiple Meters, all identical specs, different serial numbers. I want to enter it all into a form and have multiple records created. Thanks for any help or insight you can provide me.
-Chris
You could bind a subform to the table that stores your meter records and then have some unbound fields on your main form that allows you to enter the information that would be repeated in your batch of records. You could also put another unbound text box on the main form to specify the number of records you want that will have this repeated information.
So in the mock-up below, you'd specify how many records you want (red box), e.g. 10 records:
Then you'd supply the data that would be repeated for these 10 records (blue boxes):
You'd then click a button that would create the number of records specified with the repeated information given:
It would then just be a case completing the unique serial number for each of the records in the batch you have generated.
Here's the VBA I used on the Add button:
Private Sub cmdAddRecords_Click()
batchAdd Me.txtRecords
Me.tblMeters_sub.Requery
End Sub
...and the batchAdd sub routine it calls:
Public Sub batchAdd(records As Integer)
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim i As Integer
Set db = CurrentDb
Set rs = db.OpenRecordset("tblMeters")
i = 1
Do While i <= records
rs.AddNew
rs!SerialNumber = ""
rs!MeterFirmware = Me.MeterFirmware
rs!MeterCatalog = Me.MeterCatalog
rs!Customer = Me.Customer
rs!MeterKh = Me.MeterKh
rs!MeterForm = Me.MeterForm
rs!MeterType = Me.MeterType
rs!MeterVoltage = Me.MeterVoltage
rs.Update
i = i + 1
Loop
rs.Close
Set rs = Nothing
Set db = Nothing
End Sub
Here's a link to the mock-up (if you want a closer look).
Update
In response to your query about whether the subform could be filtered so it doesn't just become a big list of all meters, you could add another field to the tblMeters table that will take the date and time that you added records to the table:
You'd then need to add another line to the batchAdd sub that will put the system time and date in this new field:
...
Do While i <= records
rs.AddNew
rs!SerialNumber = ""
rs!MeterFirmware = Me.MeterFirmware
rs!MeterCatalog = Me.MeterCatalog
rs!Customer = Me.Customer
rs!MeterKh = Me.MeterKh
rs!MeterForm = Me.MeterForm
rs!MeterType = Me.MeterType
rs!MeterVoltage = Me.MeterVoltage
rs!DateAdded = Now ' <-- HERE!
rs.Update
i = i + 1
Loop
...
You'll then need to change the subform's Record Source property (Design View > select subform > Property Sheet > Data tab > Record Source):
Put the following SQL in there:
SELECT TOP 15 tblMeters.SerialNumber, tblMeters.MeterFirmware, tblMeters.MeterCatalog,
tblMeters.Customer, tblMeters.MeterType, tblMeters.MeterForm, tblMeters.MeterKh,
tblMeters.MeterVoltage, tblMeters.DateAdded
FROM tblMeters
ORDER BY tblMeters.DateAdded DESC;
... which will order the records by the date/time field (most recent at the top) and then show only the first 15 of these records. If you want a different number of records change the TOP 15 bit to a different number of your choosing.
When you click "Add", your new batch of records should be added to the top of the list and the list should stay at a maximum of 15 records (or whatever number you specify in TOP ...)
Be aware that when I was testing this, clicking the "Add" button rapidly a few times seemed to cause the sql to not bother with the TOP ... filter, but as long there's like a second or more between each "Add" click it seemed to work fine.
Hope this helps.

Ranking a dynamic table range by size

I have a dynamic table range of certain values (amounts). These amounts are generated into the table through a macro I've created.
What I want to do: Rank these amounts into the empty column by number.
eg. the cell in Column G next to 89k would be ranked as 1, one next to 77k would be 2 etc.
I also already have other functions defined, which I'm not going to explain here for readability reasons, but all you need to know: there are two variables obtained through functions
tbl_first = (int) Index of the ListRow of the first table item (so in this case it would be the row with 89k = 1st row so in this example 1)
tbl_last = (int) same as above, but indexes the last row (77k) in this example as 7
so my code is the following
' sets the tbl variable to the red table in the picture
Dim tbl As ListObject: Set tbl = Sheets("Summary").ListObjects("time_top")
Dim pos As Integer, diff as integer
diff = tbl_last - tbl_first
For j = tbl_first To tbl_last ' loops through all the added rows
For n = 1 to diff' indexing for the large function
' index the pos through the excel large function for our values (should return the k-th position from the largest value)
pos = Application.WorksheetFunction.Large(Range(Cells(tbl_first, 6), Cells(tbl_last, 6)), n)
With tbl.ListRows(1)
.Range(j, 6) = pos ' add the value to the column G to the right
End With
Next n
Next j
So the expected result would look like this:
I also keep getting the following error, which is caused by me incorrectly assigning the pos value.
Either way, probably multiple of things wrong here and much more elegant solution is out there, that just didn't hit me yet.
Think you need Rank (watch out for equal ranks). Large returns the nth largest value of a set.
Here is a simple example on a two column table which perhaps you can adapt. The rank is added in the second column.
Sub xx()
Dim tbl As ListObject: Set tbl = Sheets("Summary").ListObjects("time_top")
Dim r As Range
For Each r In tbl.ListColumns(1).DataBodyRange
r.Offset(, 1) = WorksheetFunction.Rank(r, tbl.ListColumns(1).DataBodyRange)
Next r
End Sub

Dictionary seemingly pulling same value for all keys (VBA)

I have a dictionary in which each key is a number 0-7. Each item is a collection of two number values. For each value in the dataset I am iterating through, the code checks which key 1-7 it belongs to, pulls the appropriate collection from the dictionary, adds the data to the collection, and inserts the collection back into the dictionary. It also adds every value to the 0 key in the dictionary, so that at the end the 0 key will contain a grand total i.e. the output should look like this:
Key:Value
0:100
1:20
2:10
3:10
4:20
5:10
6:5
7:25
The problem that I am having is that the output is something like:
Key:Value
0:100
1:100
2:100
3:100
4:100
5:100
6:100
7:100
It seems like each time I pull a collection from the dictionary using a key it, pulls the same collection regardless of key and then adds the data to that collection.
Dictionary:
For region = 0 To 7
regDict.Add region, blankColl
Next region
Adding items:
thisRegion = 'some number 1-7 found elsewhere
' pull the collection from the regDict
Set subtotalColl = regDict.Item(thisRegion)
subtotalSales = subtotalColl("Item") + thisSales
subtotalColl.Remove ("Item")
subtotalColl.Add Item:=subtotalSales, Key:="Item"
' replace the collection for thisRegion with the new one
regDict.Remove thisRegion
regDict.Add thisRegion, subtotalColl
' ----------- "region 0" gets every record no matter
' ----------- what the region of the record is
' pull the collection at 0 from the regDict
Set zeroSubtotalColl = regDict.Item(0)
subtotalSales = zeroSubtotalColl("Item") + thisSales
zeroSubtotalColl.Remove ("Item")
zeroSubtotalColl.Add Item:=subtotalSales, Key:="Item"
' replace the collection for Region 0 with the new one
regDict.Remove 0
regDict.Add 0, zeroSubtotalColl
The problem is that when I check the dictionary after all of this is done, every collection contains the same values! Even if I debug within this, zeroSubtotalColl from regDict(0) contains the the "new" value that I just put back into regDict(thisRegion) as subtotalColl.
Any help much appreciated.
blankColl is always a reference to the same collection, and you add it for each key, so all the "values" point to the same object.
Current:
Set regdict = CreateObject("scripting.dictionary")
Set blankColl = New Collection 'guessing here what you did...
For region = 0 To 7
regdict.Add region, blankColl
Next region
regdict(1).Add "hello"
Debug.Print regdict(7).Count '>>1 oops - should be empty!
Fix:
For region = 0 To 7
regdict.Add region, New Collection
Next region
regdict(1).Add "hello"
Debug.Print regdict(7).Count '>>0 still empty!

VBA - Output all possible combinations of data sets when grouped by data in Column A

I decided to start this question from scratch to clarify the question and goal.
Things to note about my data
I have a spreadsheet containing laptop product data
Each product has a Model and a SKU value
Many models have multiple SKUs associated with them
When more than 1 SKU fits into a model, there is a new row for each SKU. In this instance, each row will have the same value in the model field
Some models may have 4 batteries & 1 charger, others may have 1 battery & 2 chargers, others may have 1 battery & no charger or vice versa... what i'm trying to say is there is no set rule or relation between number of SKUs
There are two types of products, batteries & chargers
All Battery products have SKUs that begin with 'BAT'
All charger products have SKUS that begin with either 'ACA' or 'ACS'
I can easily split the two types of data to help achieve the goal - SKU, model & category data can be placed side by side in columns or in separate worksheets for each type of product (battery or charger)
Example data formatted side by side in same worksheet:
Example data in separate worksheets (sheet1 = batteries, sheet2 = chargers):
Regardless of which method is used, the model field could be positioned anywhere in column A - the model field will not be in an adjacent cell when comparing the two sets of data (as illustrated)
What I am trying to achieve
For each model, I need to have a row of data containing a battery SKU and a charger SKU
There should be a new row for the same model until all combinations are output for that model
There should be a maximum of 2 SKUs in the output for each row. This should always contain 1 battery and 1 charger
Desired Output
It is worth mentioning that this is a very small sample of the data I will be working with, full data set is more than 60k rows and growing so the solution would need to be efficient.
I'm using excel 2007.
I am a complete noob with VBA, I have purchased some plug ins to try and achieve my goal, I have spent 2 days researching and trying various methods to do this but all to no avail.
I thought that I had got close with this answer from Santosh:
https://stackoverflow.com/a/19780188/1018153
Which is what I based my previous question on, but as well as that producing duplicates and matching data between models, I couldn't actually format my data in it's complete form for that script to work for me anyway, so my original question was irrelevant.
The below statement should still work, but I wrote code to try to explain how it would work
Option Explicit 'This ensures typos in variable names are flagged
Sub MakeList()
Dim BatteryList As Range
Dim ChargerList As Range
Dim CurrentModel As String
Dim i As Long
Dim j As Long
Dim k As Long
Dim resultrange As String
'look at the lists - note I am not looking at the type - I'm going to assume
'that we can set the address correctly
'use End(xLdown) to find the last cell - that way we don't need to
'remember to change it when the number of items changes
Set BatteryList = Worksheets("Sheet1").Range("A2", Range("sheet1!B1").End(xlDown))
Set ChargerList = Worksheets("Sheet2").Range("A2", Range("Sheet2!B1").End(xlDown))
'note the use of the Sheet2! and sheet1! in the .End(xlDown) - this is required
'even though we have the Worksheets(" to set the range
i = 2 ' result row
For j = 1 To BatteryList.Rows.Count ' look at each battery row
CurrentModel = BatteryList(j, 1)
For k = 1 To ChargerList.Rows.Count 'then look at each charger row
If ChargerList(k, 1) = CurrentModel Then
'and only write a row if the battery and charger models match
Worksheets("Sheet3").Cells(i, 1) = CurrentModel
Worksheets("Sheet3").Cells(i, 2) = BatteryList(j, 2)
Worksheets("Sheet3").Cells(i, 3) = ChargerList(k, 2)
i = i + 1
End If
Next k
Next j
End Sub
PreviousAnswer
Looking at the code in the question you pointed to, you would need to store the current model, and only add in the possibilities when the model matches. This will result in lots of #N/A! 's when the data is written out, but that should be a minor fix.
at this line:
Do While j <= UBound(c1)
I would insert the code to hold the current model
Dim OnlyThisModel as string
Do While j <= UBound(c1)
OnlyThisModel=c1(j,1)
and in this area
Do While m <= UBound(c4)
out(n, 1) = c1(j, 1)
out(n, 2) = c2(k, 1)
out(n, 3) = c3(l, 1)
out(n, 4) = c4(m, 1)
n = n + 1
m = m + 1
Loop
Check that the model is correct, and don't write if not:
Do While m <= UBound(c4)
if c1(j,1)=OnlyThisModel then
'Only write out data if model matches
out(n, 1) = c1(j, 1)
out(n, 2) = c2(k, 1)
out(n, 3) = c3(l, 1)
out(n, 4) = c4(m, 1)
n = n + 1
end if
'go to next record, regardless of if a combination was written
m = m + 1
Loop

how to count specific word in a listview column

I have a form which is 1 list view and a text box.
* list view has a total of 100 rows of data
* list view has 5 columns
* column 3 has only two possible words yes or no
I want to count the number of occurrence of the word yes in column 3
the total row can be count with this code:
''''''''''COUNT TOTAL ADMISSION''''''''''''''
Dim rowcount As Integer = 0
For Each item As ListViewItem In LVfeestatementBA_I.Items
rowcount = CInt(item.SubItems(0).Text) 'Considering every column always have some value
Next
txttotaladBA_I.Text = rowcount.ToString()
any help will be greatfull
EDIT 1
This is a school assignment. As I said my aim is to find out the number of occurrence of a word in column 3. I have database of MS access which is connected with code and provides the data for the list view. The list view has 5 columns and there are a total of 100 rows. The data in col-3 contains only three words gen, occ, and cc. Now in want to count col-3 for the words with code and show the number like (68) in textbox1
EDIT 2
I applied the function provided by thedarkspoon, but it's not showing the result. I just want the result to be shown in textbox1, ex. if total number of words are 78 then at the time of form_load it should show 78 in textbox1. I solved the problem by adding at last textbox1.text = numofyes and change variable from integer to string now its working
I did not quite understand your scenario (you have to be more clear).
Anyway, given a ListView that displays items that each have 3 subitems and we know that the third subitem will have values of either "yes" or "no" we can build a query like (using linq):
var collectionOfListViewItems = listView1.Items.Cast<ListViewItem>();
var numberOfrowsWithTheThirdSubItemTextEqualToYes = (from c in collectionOfListViewItems where c.SubItems[3].Text == "yes" select c).Count();
Without linq you could do a foreach:
var numberOfrowsWithTheThirdSubItemTextEqualToYes = 0;
foreach (ListViewItem item in listView1.Items)
{
if (item.SubItems[3].Text == "yes")
numberOfrowsWithTheThirdSubItemTextEqualToYes++;
}
Ok here you go, I made this a function but you could easily adapt this to a subroutine:
Function countyes()
'Set up a variable to count the number of yes:
Dim numofyes As Integer = 0
'Count the number of yes (Replace listview1 with the name of your listview):
For Each item As ListViewItem In ListView1.Items
'If the Yes/No is in column 3, you are looking in subitem 2:
If item.SubItems(2).Text = "Yes" Then
'Increment the variable by one if the value is yes:
numofyes = numofyes + 1
End If
Next
'Return our total number of Yes that we found:
Return numofyes
End Function
Hope this helps!