Automatically creating unique id - vba

Im still very much a novice so be nice if I'm asking a silly question but this is my issue at the moment. I'm starting to create a database in excel for a large archive collection using a user form for the data inputting. The simple bit is that to help identify each item in the collection I want to give each item its own ID. The harder bit is that I want the ID to also include a prefix that makes it clear what sort of item it is. For example the follow prefixes;
Description | Prefix
-----------------------
Newsletter | NEW
Minutes | Min
Photograph | Pho
and to add to the challenge is to have the ID to be sequential under its own prefix (they by not be grouped together though) so the list of IDs could end up like this;
NEW1
NEW2
PHO1
PHO2
PHO3
MIN1
NEW3
MIN2
IF you can suggest anything to help me achieve this i would be most grateful. Thanks in advance.

This assumes a form with a Listbox that has the three choices, a Button to generate the next record ID and a Textbox to display it.
It assumes that the existing IDs are in Column A of the ActiveSheet when the form is activated:
Private Sub UserForm_Activate()
With Me.ListBox1
.AddItem "PHO"
.AddItem "NEW"
.AddItem "MIN"
End With
End Sub
Private Sub CommandButton1_Click()
Dim ws As Excel.Worksheet
Dim Category As String
Set ws = ActiveSheet
Category = Me.ListBox1.Value
Me.TextBox1 = Me.ListBox1 & Application.Evaluate("=MAX(IFERROR(SUBSTITUTE('" & ws.Name & "'!A1:A10," & """" & Category & """" & ","""")*1,0))") + 1
End Sub
It uses Application.Evaluate, which evaluates an array formula as if it was entered into a cell. If the formula was entered into a cell and there were values in A1:A10, and you'd selected "NEW" in the listbox, it would look like this:
And here's the result in the form:

In a database, it is really best to make your ID code be completely free of meaning. That is, do not include the "item type" as a part of your unique ID. It should be a field of its own. The ID code should be nothing more than a unique identifier.

Related

How to alphabetize fields in Unhide Columns dialog box in Access VBA?

I have a ton of columns in this table and I want them to be alphabetized so they are easier to find.
I remember seeing how to do this in a Youtube video but I can't find it for the life of me. Below is an example of the code I am using in multiple datasheet type forms. I'm not sure what needs to be added in to make these field lists alphabetize
Private Sub showHideColumns_Click()
frmInventoryListSubform.SetFocus
DoCmd.RunCommand acCmdUnhideColumns
End Sub
The "columns", the controls, have both a name and, optionally, a caption.
So, in your form, you can run this code to list these:
Private Sub ListColumns()
Dim Control As Control
Dim Index As Long
For Index = 0 To Me.Controls.Count - 1
Set Control = Me.Controls(Index)
If Control.ControlType <> acLabel Then
Debug.Print Index, Control.Name, Control.Properties("DatasheetCaption").Value
End If
Next
End Sub
May return a result like this:
0 StipendNo Student Number
2 PayNo Pay Number
4 PayDate
6 PayAmount

Returning a quick statistical info for a cell as a comment

I have a long list of data on an excel table. This data includes detail information of each order in several rows. There is a column shows the status of each row. Also, I have a dashboard which just lists out the order names. I want the users to be able to see a short statistical info of each book as a comment or when they mouse over the cell, if possible or as a cell data. The info could be something like underneath sample in 3 or 4 row. (The number of items is the count of rows with the same status)
5 issued item
3 shortage items
2 Done items
X other
If you just give me the general idea it would be great.
I think I have to use a collection procedure, something like "scripting dictionary" but I have no experience using them. I know how to do that by putting a case statement after if clause inside a loop, but I am looking for a smarter way. you can find some pictures and a sample data below: sample pictures
For the record, I came to this answer from one of friends in MrExcel froum. Hope you find it usefull.
The just difference is, I was looking for a momentum reply just for an active cell, but this code, provide all the information for all the order names as a comment. but it is very easy to adjust!
Sub UpdateComments()
Dim c As Variant, strComment As String
Dim intISSUED As Integer, intSHORTAGE As Integer
Dim tblDATA As ListObject, tblDASH As ListObject
Set tblDATA = Application.Range("TBL.data").ListObject 'adjust Table Name
Set tblDASH = Application.Range("TBL.dash").ListObject 'adjust Table Name
For Each c In tblDASH.ListColumns("W/B").DataBodyRange
strComment = ""
intISSUED = Application.CountIfs(tblDATA.ListColumns("Work Book").DataBodyRange, c, tblDATA.ListColumns("Stage").DataBodyRange, "Issued")
strComment = strComment & Chr(10) & "Issued: " & intISSUED
intSHORTAGE = Application.CountIfs(tblDATA.ListColumns("Work Book").DataBodyRange, c,tblDATA.ListColumns("Stage").DataBodyRange, "Shortage")
strComment = strComment & Chr(10) & "Shortage: " & intSHORTAGE
' ADDITIONAL 'STAGES' HERE
' OR put 'stages' in array to condense code
With Sheets(tblDASH.Parent.Name).Range(c.Address)
If .Comment Is Nothing Then
.AddComment
.Comment.Visible = False
End If
.Comment.Text Text:=Mid(strComment, 2)
End With
Next c
End Sub

How to autocomplete a line with data suggestion?

Context:
In my company, some assistants fill out an Excel table, which is a users list (First Names, Last name, ID number). After, I use this list with a PowerShell script. But very often the users list is not correctly completed. For example, assistants forget to input ID number... .So i would like help assitants to fill this Excel with data suggestions/autocomplete.
Technical:
In the "Data" sheet, I have all data possible (First Names, Last name, ID number).
With the "Name Manager" I created:
d_FirstName to select the first cell
c_FirstName to select all column,
l_FirstName to apply function: =OFSSET(d_FirstName;0;0;COUNTA(c_FirstName)-1;1)
In "Form" sheet, I created drop-down list with function: =IF(A1<>"";OFSSET(d_FirstName;MATCH(A1&"*";l_FirstName;0)-1;;SUMPRODUCT((MID(l_FirstName;1;LEN(A1))=TEXT(A1;"0"))*1));l_FirstName)
So, when the user types a letter, the drop down list "suggest" a correct FirstName.
Question:
How to adapt the last query, to complete a line with First Name and Last name and ID number corresponding if user type only First Name ?
For example:
If user select a First Name in drop down list, Excel complete the lign with Last name and ID number corresponding .
If user select a ID number in drop down list, Excel complete the lign with Last name and First Name corresponding.
In second time, how to show dropdown list automatically when user type one letter ?
Thank you
You can accomplish this using the combobox's properties and change event. The combobox will take a 1 or 2 dimensional named range or a formula that returns a range as it's RowSource. Here I have the text column set to the 3rd column.
Private Sub cboEmpID_Change()
With cboEmpID
If Not IsNull(.Value) Then
lblEmployee.Caption = .List(.ListIndex, 1) & ", " & .List(.ListIndex, 0)
End If
End With
End Sub
Private Sub UserForm_Initialize()
Dim ColumnWidths As String
With Worksheets("Sheet1")
ColumnWidths = .Columns(1).Width & ";" & .Columns(2).Width & ";" & .Columns(3).Width
End With
With cboEmpID
.ColumnHeads = True
.ColumnCount = 3
.ColumnWidths = ColumnWidths
.TextColumn = 3
.ListWidth = Range("Sheet1!A:C").Width
.RowSource = "OFFSET(Sheet1!$A$1,1,0,COUNTA(Sheet1!$A:$A)-1,3)"
End With
End Sub
You need making a cascading dependent Excel drop down list.See

Extract data from excel for input loop in VBA scraping

I am a complete novice in VBA and I'm in way over my head I think but the research necessitates it. I followed a great online tutorial series, which unfortunately didn't help me in solving 1 big problem: Data input.
My goal is to scrape patent data from google patents. To do so, it's pretty convenient that Google patents website is uniquely identified by the patent number. Thus what I want to achieve is the following:
Extract the patent number from a list in excel
Use that number to access the specific webpage
Extract application and publication year of patent, as well as patent number (as check)
Store all in a single excel sheet
Now, I can make 2,3, and 4 work but it's the loop that allows me to extract the patent numbers from excel and put them into my code that I am missing.
Here is the current code:
Private Sub CommandButton4_Click()
Dim obMF As Object
Dim patent As String
Dim grant_date As String
Dim app_date As String
Dim patent_number As String
patent_number = insert.Text ' insert.Text refers to a textbox in my interface
Call gotopat(patent_number, patent, app_date, grant_date)
found.Text = patent
grantdate.Text = grant_date
appdate.Text = app_date
output_row = 1 'Set the output row as 1 (this is where the title is)
Do
DoEvents
output_row = output_row + 1 'Increase output row with 1
Loop Until Sheets("bkcit").Range("B" & output_row) = ""
'Continue loop until that cell ~ Range is blank.
'Once a blank is found, we can put new data in there
'Store data into Worksheet "bkcit"
Sheets("bkcit").Range("B" & output_row) = patent
Sheets("bkcit").Range("C" & output_row) = grant_date
Sheets("bkcit").Range("D" & output_row) = app_date
In this code, found.Text, grantdate.Text, and appdate.Text are sourced from the scraping function which works perfectly. The important things about that function are:
Function gotopat(patent_number As String, patent As String, app_date As String, grant_date As String)
' A Bunch of other stuff
obMF.Navigate ("http://www.google.com/patents/US" & patent_number & "?")
'All the scraping code'
So, I want to replace the patent_number = insert.Text by a loop that looks in my excel sheet bkcit, column A and basically loops through all the unique patent numbers. I tried
input_row = 1
Do
DoEvents
input_row = input_row + 1
Range("C" & input_row) = patent_number
Loop Until Sheets("bkcit").Range("A" & input_row) = ""
But this seems to delete the first patent number in cell A2 and nothing more.
I'm thinking I'm pretty close to a working solution but your help would be fantastic, as always!
Thanks in advance
Simon
If I understand correctly, you have a column of patent numbers like this:
And you want to loop through each number and do something to it. Try this:
Sub loopPatents()
Dim patentNumber As Range
Dim patentRange As Range
Set patentRange = Worksheets(1).Range("A2:A10")
For Each patentNumber In patentRange
MsgBox ("Patent number: " & patentNumber)
'Do your stuff with the patent number here
Next patentNumber
End Sub

Put entire column (each value in column) in an array?

So i'm making a macro to do a bunch of things. one thing is find duplicates of cells in sheet1 from sheet2. given columnA in sheet 1, do any values in columnB on sheet2 match any of the values in columna sheet1.
I know theres a remove duplicates, but I just want to mark them, not remove.
I was thinking something with the filtering. I know when you filter you can select multiple criteria, so if u have a column with 20 different values in it, you can select 5 values in the filter and it will show rows with those 5 values for the particular column. So i recorded a macro of that, and checked out the code, and I see for that it uses a string array, where each value to search for is in a string array. Is there any way to just specify an entire column and add every value to the string array?
thanks in advance
Here are three different ways to load items into an array. The first method is much faster but simply stores everything in the column. You have to be careful with this though because it creates a multidimensional array which isn't something that can be passed to AutoFilter.
Method 1:
Sub LoadArray()
Dim strArray As Variant
Dim TotalRows As Long
TotalRows = Rows(Rows.Count).End(xlUp).Row
strArray = Range(Cells(1, 1), Cells(TotalRows, 1)).Value
MsgBox "Loaded " & UBound(strArray) & " items!"
End Sub
Method 2:
Sub LoadArray2()
Dim strArray() As String
Dim TotalRows As Long
Dim i As Long
TotalRows = Rows(Rows.Count).End(xlUp).Row
ReDim strArray(1 To TotalRows)
For i = 1 To TotalRows
strArray(i) = Cells(i, 1).Value
Next
MsgBox "Loaded " & UBound(strArray) & " items!"
End Sub
if you know the values ahead of time and just want to list them in a variable you can assign a variant using Array()
Sub LoadArray3()
Dim strArray As Variant
strArray = Array("Value1", "Value2", "Value3", "Value4")
MsgBox "Loaded " & UBound(strArray) + 1 & " items!"
End Sub
not sure if anyone else will have this problem or not so I figured I'd post the answer I found. I like the solution of the array posted by #Ripster (and thanks for that, it almost worked) but it won't really work in this case. What I'm working with is a large sheet of data with 1 ID column, and I want to check other sheets to see if there are duplicates in that sheet (using ID column). not delete though, just mark so I can check them out. With potentially upwards of 50K rows looping through each row would take a LONG time.
So, what I figured out I can do is copy the ID column from the other sheet into the main sheet, and use the conditional formatting option to mark duplicates in some colour. (It'll mark the rows in both columns) and then I can filter the column by colour to show me only the colour I used to mark the duplicates. If I programmatically add a column to the sheet I'm checking with the row numbers, I can even include that column in the main sheet so when I filter for colour I can see which rows they were in their sheet.
After doing that I can record and adapt a macro to do this automatically for my less programming inclined co-workers
Thanks much all!
Edit - Added Code
After selecting the columns to compare, here is the code to mark the duplicates with red text and no fill:
Selection.FormatConditions.AddUniqueValues
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
Selection.FormatConditions(1).DupeUnique = xlDuplicate
With Selection.FormatConditions(1).Font
.Color = -16383844
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
and then, since both columns have the duplicates marked you select the one that you actually want to examine and heres the code to filter:
`Selection.AutoFilter
ActiveSheet.Range("$C$1:$C$12").AutoFilter Field:=1, Criteria1:=RGB(156, 0 _
, 6), Operator:=xlFilterFontColor`
(in my test i used column c as the one to filter, that can be programmatically with a cells() reference or a range(cells(), cells()) sort of reference
I wish everyone the best of luck in their future endevors! thanks again to #ripster