First, let me say this. I am new to using access and VBA functions.
My overall goal is to add functionality to my database as described below:
This database consists of patients enrolled in a Clinical Trial, these patients have a unique identifier in the format GKID-XXXXX where the XXXXX is an alphanumeric base 35 counting system.
Eg. the numbering goes like this GKID-00000, GKID-00001, GKID-00002, GKID-00003,... , GKID-0000Z. Base 35 because it exclude the letter O.
Previously, we would generate these IDs and type them in manually. However, in the future, we would like these to be automatically created when a new patient is added to the database. However,
we want to retain the ability to add IDs in manually without changing any existing IDs, delete records without changing the assigned IDs, and the IDs created cannot be already used.
I have tried many things and the naive strategy I have made progress with is as follows.
Take the existing "Working Table" that contains all of the existing IDs in a field. This field would be left blank for newly added patients who we want to automatically generate an ID for.
Using this working table, create a new table with a query. This would be the table with the IDs. It would exactly match the existing table except the ID column from the first table would be replaced with one that generates IDs with a custom VBA function. The function takes the Working Table ID field in as a variable and returns the generated ID. If the field is occupied, it simply returns the ID, if not, it generates a new one. Below is the progress I have made in accomplishing this.
Option Compare Database
Function GavFun2(EIID As String) As String
strAlphabet = "0123456789ABCDEFGHIJKLMNPQRSTUVWXYZ"
These are the characters in the base 35 counting system.
N = Mid(EIID, 6, 5)
This simply extracts the 5 alphanumeric digits of the Working Table ID
Dec = (InStr(strAlphabet, Mid(N, 5, 1)) - 1) * 35 ^ 0 + (InStr(strAlphabet, Mid(N, 4, 1)) - 1) * 35 ^ 1 + (InStr(strAlphabet, Mid(N, 3, 1)) - 1) * 35 ^ 2 + (InStr(strAlphabet, Mid(N, 2, 1)) - 1) * 35 ^ 3 + (InStr(strAlphabet, Mid(N, 1, 1)) - 1) * 35 ^ 4
This Decodes this back into a base 10 system
GavFun2 = GavFun(CInt(Dec))
This converts the number back into the base 35 system and returns the ID in its full string form (function included below).
If EIID = Empty Then
End If
End Function
This if statement is where I am running into a wall. I want to fund the maximum value of Cint(Dec), then simply return GavFun2 = GavFun(Max(Cint(Dec))+1). I feel like this would be a good start, but there would be a number of problems if I was able to even get this to work.
A. If there ware multiple blank records, they would all have the ID (maybe replace with a for loop that runs through each blank consecutively and start the counter at Max(Cint(Dec))+1, but I don’t know how to do this.)
B. If I were to add a new patient with a custom ID (or delete one), this could potentially change all of the generated IDs.
Any thoughts on my general approach or advice on how to proceed would be very much appreciated. Thank you so much for your help.
Option Compare Database
Function GavFun(IDD As Integer) As String
strAlphabet = "0123456789ABCDEFGHIJKLMNPQRSTUVWXYZ"
If IDD = 0 Then
GavFun = "0"
Exit Function
End I
GavFun = vbNullString
Do While IDD <> 0
GavFun = Mid(strAlphabet, IDD Mod 35 + 1, 1) & GavFun
IDD = IDD \ 35
Loop
ZZ = Array("0", "00", "000", "0000", "00000")
L = Len(CStr(GavFun))
MM = ZZ(4 - L)
GavFun = "GKID-" & MM & GavFun
End Function
Ok, the way to approach this?
Well we often need all kinds of speical numbering systems. For invoice, PO numbers, maybe a badge number, employee numbers etc. Now in these cases? Such numbers have VERY little to do with relational databases. I mean becuase you might not yet have some silly invoice number, your whole software package comes crashing down?
So, such external numbers? They don't have anything to do with how you build your relationships between tables. For that you use the PK (ID - autonumber), and then the FK (forighen key) in the child table. things like City, invoice number, name etc? That's just data you store - ZERO to do with relationships.
Ok, so now that we got above out of the way.
First up:
You don't want to hit the whole database to find some max number or some such. While this might work for single user, it not really a good idea.
So, for badge numbers, incrementing product numbers, invoice numbers, and hey, maybe even a clincial trial number?
You create a table with a SINGLE row in that table. That way you can then even say go and change/set what the starting number/point is to be. So yes, you ARE on the right tack - you want to build your own custom numbering system, and then use that for a column in that table (as I stated, this is just a number, or value - not different then city, first name, or say some invoice number - NOTHING to do with the PK, and NOTHING to do with relatonal database stuff.
Ok, so, now we need some things here.
First, we need that table that keeps track of this number for us.
Next, we need a routine to get this "value" and then increment the value for the next time.
And then we need to setup a nice way to get and then put/shove/have that number auto matic be setup and entered into that form for us, and of course make sure if that record already has a number, we don't over write it.
Thus we can break this problem down into separate parts.
First, create our increment number handy dandy maintains table like this:
So that's our table. Nice part is we can edit the starting number, and even the prefix - so if you do another run/study, we can easy start a new number set. we DON'T care about the existing data - build a number system - it just runs and works like a good water pump.
Ok, next we need our routine to go please get me the next number.
Our code can work like this:
Public Function GetNextPID() As String
Const Alpha = "0123456789ABCDEFGHIJKLMNPQRSTUVWXYZ"
Const MaxDigts = 4
Const Base = 35
Dim OnePart As Long
Dim OneDigit As Long
Dim rstNext As DAO.Recordset
Dim OurNum As Long
Dim i As Integer
Dim strResult As String
Dim strPrefix As String
Set rstNext = CurrentDb.OpenRecordset("NextPatientNum")
OurNum = rstNext!NextNumber
strPrefix = rstNext!Prefix
rstNext.Edit
rstNext!NextNumber = OurNum + 1
rstNext.Update
rstNext.Close
' convert our number to base
Dim s As String
For i = MaxDigts - 1 To 0 Step -1
OnePart = Int(OurNum / (Base ^ i))
s = Mid(Alpha, OnePart + 1, 1)
strResult = strResult & s
OurNum = OurNum - Int(OnePart * (Base ^ i))
Next i
GetNextPID = strPrefix & "-" & strResult
End Function
So, place the above code function in a standard code module (not in a form).
Now, hit ctrl-g, and we can test it like this from the debug (immediate window)
? GetNextPID
Output: GKID-0007
So, now you can just edit that "one row" maintains table to start at whatever number you like or feel like. once you set that number, then each time you call that routine, it will go get you the next number based on our new number system.
Now, all we have to do is in that form? Well, we could just write code to check if the text box/field is not yet set, but there is ALSO a event on the form that fires ONLY when you add/insert that record in the form. It not 100% clear when/how your form works, but we can do something like this:
Private Sub Form_BeforeInsert(Cancel As Integer)
Me.PatientNum = GetNextPID
End Sub
(of course you don't type in the event stub part).
Note close: if the record is blank - not dirty, then nothing happens. You can even close the form. However, the instant you start typing anything into that form with a new record, then like magic that code will run, and shove in the new number into that text box on the form, the new patient number will appear.
As noted, we can even go edit that maintains table, give it a new prefix and new number for a whole new study.
Edit: feel free to use your existing logic - either way, don't try and hit/use the database table with existing data to get/make/generate the new ID - use your function idea, but it will simple automatic return + generate the next new number you need upon calling that function.
I have the following code for inserting new rows into a table (also shifting down the content below the table), but it's using ActiveCell. Is it possible to use it for a defined sheet, table names and multiple rows like defined below the code.
With ActiveCell.ListObject
ActiveSheet.Rows(.HeaderRowRange.Row + .ListRows.Count + 1).insert
.Resize (ActiveSheet.Range(.HeaderRowRange(1, 1), Cells(.HeaderRowRange.Row +
.ListRows.Count + 1, .ListColumns.Count)))
End With
Set newsheet = ThisWorkbook.Sheets("GeneralInfo")
tablename = "Table1"
newrows = 15
First up, how do you find your ListObject? I generally use this syntax :
Range("Table1").ListObject
The Range("Table1") bit allows me to find the ListObject even if I don't know what sheet it's on. This works because Tables are also Named Ranges that you can address by name. So you just say "Go to the Named Range called Table1, and get me the ListObject that lives there". Otherwise you would need to know in advance what sheet the ListObject is on, and use the following:
Worksheets("SomeSheet").Listobjects("Table1")
...which works just fine until one day you move the Table to a different sheet, and forget to update your code.
Next, how to add rows? To add a single listrow, just use:
Range("Table1").ListObject.ListRows.Add X
...where X is the ListRow number you want it to be added in above. Put 1 for the top, 2 for the second, and so on. Leave it blank and your ListRow gets added to the bottom.
But that only lets you add 1 ListRow at a time. So you've got three choices:
Create a loop, do it 15 times
Simply resize the ListObject so that 15 rows get added to the end
Just insert entire sheet rows at the position you want the new ListRows, using something like this:
Rows("16:30").Insert Shift:=xlDown
I know this may sound trivial but I just can't find an answer to it.
I have a rdlc report in which I like to alternate row background color and for this I've used the following formula:
=iif(RowNumber(Nothing) Mod 2, "#e5e5e5", "White")
I also need to hide some rows and for this I use the following formula:
= Fields!MeanAeb.Value <> ""
where MeanAeb is a field in my report. My problem is that rowNumber also counts the hidden rows, so my table may have two consecutive rows with the same background. is there a way to take only visible rows into account?
So if anyone has the same problem, I have an answer;
in the Code section of your ReportProperties add the following
Dim customRowNumber as Integer = 0
Dim previousRowNumber as integer = 0
Function CustomRowCounter(conditionToTest as Boolean, rowNumbner as Integer) as Integer
if(conditionToTest and rowNumbner <> previousRowNumber)
customRowNumber = customRowNumber + 1
previousRowNumber = rowNumbner
end if
return customRowNumber
End Function
then on the background field in your column properties add this condition:
=iif(Code.CustomRowCounter(Fields!MeanAeb.Value="",RowNumber(nothing)) Mod 2, "#e5e5e5", "White")
this is nice because you can add any condition you like in place of Fields!MeanAeb.Value="". Just remember to use the inverse of the condition in your rowVisibility field, otherwise you may cause strange effects.
Oh and if you want a chess board look to your report just drop the previousRowNumber :)
My Goal: To get all data about the same subject from multiple reports (already in the same spreadsheet) in the same row.
Rambling Backstory: Every month I get a new datadump Excel spreadsheet with several reports of variable lengths side-by-side (across columns). Most of these reports have overlapping subjects, but not entirely. Fortunately, when they are talking about the same subject, it is noted by a number. This number tag is always the first column at the beginning of each report. However, because of the variable lengths of reports, the same subjects are not in the same rows. The columns with the numbers never shift (report1's numbers are always column A, report2's are always column G, etc) and numbers are always in ascending order.
My Goal Solution: Since the columns with the ascending numbers do not change, I've been trying to write VBA code for a Macro that compares (for example) the number of the active datarow with from column A with Column G. If the number is the same, do nothing, else move all the data in that row (and under it) from columns G:J down a line. Then move on to the next datarow.
I've tried: I've written several "For Each"s and a few loops with DataRow + 1 to and calling what I thought would make the comparisons, but they've all failed miserably. I can't tell if I'm just getting the syntax wrong or its a faulty concept. Also, none of my searches have turned up this problem or even parts of it I can maraud and cobble together. Although that may be more of a reflection of my googling skill :)
Any and all help would be appreciated!
Note: In case it's important, the columns have headers. I've just been using DataRow = Found.Row + 1 to circumvent. Additionally, I'm very new at this and self-taught, so please feel free to explain in great detail
I think I understand your objective and this should work. It doesn't use any of the methodology you were using as reading your explanation I had a good idea how to proceed. If it isn't what you are looking for my apologies.
It starts at a predefined column (see FIRST_ROW constant) and goes row by row comparing the two cells (MAIN_COLUMN & CHILD_COLUMN). If MAIN_COLUMN < CHILD_COLUMN it pushes everything between SHIFT_START & SHIFT_END down one row. It continues until it hits an empty row.
Sub AlignData()
Const FIRST_ROW As Long = 2 ' So you can skip a header row, or multiple rows
Const MAIN_COLUMN As Long = 1 ' this is your primary ID field
Const CHILD_COLUMN As Long = 7 ' this is your alternate ID field (the one we want to push down)
Const SHIFT_START As String = "G" ' the first column to push
Const SHIFT_END As String = "O" ' the last column to push
Dim row As Long
row = FIRST_ROW
Dim xs As Worksheet
Set xs = ActiveSheet
Dim im_done As Boolean
im_done = False
Do Until im_done
If WorksheetFunction.CountA(xs.Rows(row)) = 0 Then
im_done = True
Else
If xs.Cells(row, MAIN_COLUMN).Value < xs.Cells(row, CHILD_COLUMN).Value Then
xs.Range(Cells(row, SHIFT_START), Cells(row, SHIFT_END)).Insert Shift:=xlDown
Debug.Print "Pushed row: " & row & " down!"
End If
row = row + 1
End If
Loop
End Sub
I modified the code to work as a macro. You should be able to create it right from the macro dialog and run it from there also. Just paste the code right in and make sure the Sub and End Sub lines don't get duplicated. It no longer accepts a worksheet name but instead runs against the currently active worksheet.
I've got a table in a word document which I'm trying to add a row to. This additional row needs to be the same as the first row in the table which serves as a template.
Let's assume my table has exactly one row to begin with. I would now like to add a new row with the same specifications, then merge all 3 columns. Under that I would like to add an additional row, but with 3 columns again like the first row.
What I tried:
Dim oTemplateRow As Word.Row
Set oTemplateRow = oTable.Rows(1)
oTemplateRow.Range.Copy
' adds a row like the template one
oTable.Rows.Last.Range.Paste
So far, so good. But if I now merge the cells in that line and then repeat the paste, the new line appears before the previously added one, even with a collapse of the range before - this is what I do not understand.
oTable.Rows.Last.Cells.Merge
oTable.Rows.Last.Range.Collapse Direction:=wdCollapseEnd
oTable.Rows.Last.Range.Paste
oTable.Rows.Last.Range.Collapse Direction:=wdCollapseEnd
Any help would be greatly appreciated.
It appears that I am now able to answer my own question. Although it may not be the most elegant solution, it solves my problem. I have simply used
oTable.Rows.Add
after the initial row had been created, therefore creating an exact copy underneath. When I need to add a row, I repeat that process and keep working on the one previous to the last one.
Private Function addRow(ByRef oRow As Word.Row, Optional iNumberColumns As Integer = 3)
' add a row to the end, then work on the one before that
oTable.Rows.Add
Set oRow = oTable.Rows(oTable.Rows.Count - 1)
' if number of columns is 1 merge 2 to 4, if 2 merge 3 to 4
Select Case iNumberColumns
Case 1
oRow.Cells(2).Merge MergeTo:=oRow.Cells(4)
Case 2
oRow.Cells(3).Merge MergeTo:=oRow.Cells(4)
End Select
End Function
May be a bit longwinded, but works for me.
Regards
Stefan