MSAccess Sorting column with text and numbers - sorting

I need to sort a column in my Access2010 Query correctly. It is a Textcolumn containing Strings with numbers like "CRMPPC1". The text length may vary within the column.
When I sort this it looks like
CRMPPC1
**CRMPPC10**
CRMPPC2
CRMPPC3
CRMPPC4
....
But what I need is
CRMPPC1
CRMPPC2
CRMPPC3
CRMPPC4
....
**CRMPPC10**
Can anybody help me out (preferably with SQL)? I tried various approaches like VAL, CAST etc. but nothing works so far.

If the number of characters in the text prefix is variable then I don't think there is a pure Access SQL solution, but the VBA function
Public Function ExtractNumber(textString As Variant) As Long
Dim s As String, i As Long
s = Nz(textString, "")
For i = 1 To Len(s)
Select Case Mid(s, i, 1)
Case "0" To "9"
Exit For
End Select
Next
If i > Len(s) Then
ExtractNumber = 0
Else
ExtractNumber = Val(Mid(s, i))
End If
End Function
would allow you to use a query like this
SELECT textTest.*
FROM textTest
ORDER BY ExtractNumber([textColumn]);

Try out using this 'hack' for natural order sorting. It only works for two characters, but you can modify it for more of course.
'''' ONLY WORKS WITH LAST TWO CHARACTER NUMBERS AT THE END. IF YOU HAVE THREE NUMBERS IT WILL BREAK'''''''
Function PadNumberForNatSort(strToMod) As String
If IsNumeric(Right(strToMod, 1)) = True Then
If IsNumeric(Mid(strToMod, Len(strToMod), 1)) = True And IsNumeric(Mid(strToMod, Len(strToMod) - 1, 1)) = True Then
PadNumberForNatSort = strToMod
Else
PadNumberForNatSort = Mid(strToMod, 1, Len(strToMod) - 1) & "0" & Mid(strToMod, Len(strToMod), 1)
End If
Else
PadNumberForNatSort = strToMod
End If
End Function
In your SQL: ORDER BY PadNumberForNatSort([column_name])

Related

Elegant way to pass as an optional parameter to make the subroutine work as if it was omitted?

In VB6, the function Mid(string, start, [length]) has an optional parameter length. If omitted, the whole characters after the start bound will be passed.
Say I want this default behaviour only in a certain condition:
s = Mid(s, i, IIf(condition, j, TheValue)) ' What could be TheValue?
Since length is of Variant type, I tried Empty. It didn't work. Neither did -1 and Nothing.
I didn't want to duplicate to Mid call in an If-Then-Else clause or somehow else. Is this possible?
Here is a working sample with OP's s = Mid(s, i, IIf(condition, j, TheValue)) line
Option Explicit
Property Get TheValue(Optional RetVal As Variant)
TheValue = RetVal
End Property
Private Sub Form_Load()
Dim s As String
Dim i As Long
Dim j As Long
Dim condition As Boolean
s = "test test test"
i = 6: j = 3
condition = False
s = Mid(s, i, IIf(condition, j, TheValue)) '<--- this works!
Debug.Print s
End Sub
Notice how TheValue returns a "missing" Variant i.e. one which tests positive for IsMissing and can be used in place of optional parameters instead of not passing actual argument.
No such value exists. When you omit the length parameter, the compiler chooses a different path through the VBRT -- it produces different code. If you want to emulate that, you need to do the same thing, using an If-Else or similar construct to handle the two cases, like #ÉtienneLaneville suggests
As an alternative to #Étienne's solution, VB provides the IsMissing method:
Public Function Mid(p_sString As String, p_iStart As Integer, Optional p_iLength As Integer) As String
If IsMissing(p_iLength) Then
Mid = VBA.Mid(p_sString, p_iStart)
Else
Mid = VBA.Mid(p_sString, p_iStart, p_iLength)
End If
End Function
And as this wrapper method returns a string, I suggest using the String verions of Mid, which is Mid$. The later is slightly faster than the Variant version (Mid)
This was nicely explained at this site, but at the time of this posting, the request times out. Not sure if gone forever or just a temporary problem.
You could define your own Mid function:
Public Function Mid(p_sString As String, p_iStart As Integer, Optional p_iLength As Integer = -1) As String
If p_iLength < 0 Then
Mid = VBA.Mid(p_sString, p_iStart)
Else
Mid = VBA.Mid(p_sString, p_iStart, p_iLength)
End If
End Function
This should work with the code from your question, using -1 (or any negative integer) as TheValue.
In c++, std::string these optional arguments are represented by either 0 when the default effect is zero position or length or std::string::npos when it is "infinite" length. You can explicitly supply that value and get the same behaviour.
I don't know what the equivalent constant is in m/s strings [In fact it is a different function definition, so there isn't one]. The alternative would be to pass in the string length, as that is the longest length currently possible.
The ?: ternary operator is an easy way to present 2 values with a condition to choose between them.

Why does my "random key code" creates a same key every once in a while?

I`m having the following code from which I extract randomPW for my db.
I need this string of random characters in order to use it a primary key in my Db. The problem is that I`m getting quite a lot of duplicates when I execute this code more than once or if I get a Loop in order to extract (for example) 100 keys at once.
If I try to reload the page in order to insert one by one key the same problem occurs... every 50-80 reloads there is a duplicate. What's wrong with my code?
<%
Function RandomPW(myLength)
Const minLength = 6
Const maxLength = 20
Dim X, Y, strPW
If myLength = 0 Then
Randomize
myLength = Int((maxLength * Rnd) + minLength)
End If
For X = 1 To myLength
Y = Int((3 * Rnd) + 1) '(1) Numeric, (2) Uppercase, (3) Lowercase
Select Case Y
Case 1
'Numeric character
Randomize
strPW = strPW & CHR(Int((9 * Rnd) + 48))
Case 2
'Uppercase character
Randomize
strPW = strPW & CHR(Int((25 * Rnd) + 65))
Case 3
'Lowercase character
Randomize
strPW = strPW & CHR(Int((25 * Rnd) + 97))
End Select
Next
RandomPW = strPW
End Function
%>
I expect my code to extract a string that will not duplicate every now and then.
I need this string of random characters in order to use it a primary key in my Db.
In this case I would recommend to use Scriptlet.TypeLib :
Function RandomPW(myLength)
Set TypeLib = CreateObject("Scriptlet.TypeLib")
If myLength < Len(TypeLib.Guid)
RandomPW = Left(TypeLib.Guid, myLength)
Else
RandomPW = TypeLib.Guid
End If
End Function
Randomize is not supposed to be used more than once, unless you want to make sure you are creating fake, repeatable randomness. Per docs, helpfully linked by Lankymart (emphasis mine):
Randomize uses number to initialize the Rnd function's random-number generator, giving it a new seed value. If you omit number, the value returned by the system timer is used as the new seed value.
The system timer referred to above is in seconds; which means, successive calls to Randomize in short succession will make sure the following Rnd is yielding the same value.
It would likely help you immensely to remove all calls to Randomize.

Variable values in For Each loop being retained

I'm new to VBScript and I am running into some trouble. The script is making an API call and pulling account information, placing the data into a CSV file. I'm pulling the data into an array, looping through each account and, if certain properties qualify, assigning them to a variable to be written to the CSV. The problem I am having is if one account qualifies for a property, it sets the variable and if the next account doesn't qualify, the variable is still retaining the value, giving false results in the CSV.
Set SFTPServer = WScript.CreateObject("SFTPCOMInterface.CIServer")
accounts = SFTPServer.AdminAccounts
For each admin in accounts
adminName = admin.Login
Dim count : count = admin.GetPermissionsCount()
For i = 0 To CInt(count )- 1
Set permission = admin.GetPermission(i)
' AdminPermissionsPolicy:
' ServerManagement = 0,
' SiteManagement = 1,
' STManagement = 2,
' UserCreation = 3,
' ChangePassword = 4,
' COMManagement = 5,
' ReportManagement = 6,
Select case permission.Permission
case 0:
serverAdmin = "Server Admin"
case 1:
site = permission.SiteName
case 2:
stMan = "2"
case 3:
userCreate = "3"
case 4:
chPassword = "4"
case 5:
comMan = "5"
case 6:
report = "6"
End Select
Next
WriteStuff.WriteLine""+adminName+"|"+site+"|"+stMan+"|"+userCreate+"|"+chPassword+"|"+comMan+"|"+report+"")
Next
Unfortunately variables in VBScript are either at global, or function scope.
So you'll need to reset each of the variables on each iteration of the for loop.
One way would be to write Dim dummy at the top of your script, and just before the Select Case, write serverAdmin = dummy, site = dummy etc.
It's good practice to Dim explicitly all your variables, and to use Option Explicit at the top of the module to enforce that.
Here's an alternate way to do what you need without having to empty each variable on each iteration. You've already documented what each value means in your code. Instead of using comments for that purpose, define them as constants at the top of your scope block:
' AdminPermissionsPolicy:
Const ServerManagement = 0
Const SiteManagement = 1
Const STManagement = 2
Const UserCreation = 3
Const ChangePassword = 4
Const COMManagement = 5
Const ReportManagement = 6
Then you can declare an array to hold the values:
Dim a(6)
And then in your loop you can empty the array on each iteration using the Erase function. You can use the constant names instead of 0/1/2/etc and, when it comes time to write the values, you can use Join() to combine your array values into a string instead of having to concatenate 7 variables.
For each admin in accounts
adminName = admin.Login
Erase a ' Empty the Permissions array for each new account
Dim count : count = admin.GetPermissionsCount()
For i = 0 To CInt(count )- 1
Set permission = admin.GetPermission(i)
Select case permission.Permission
case ServerManagement: ' Now you can use the constant instead of "0"
a(ServerManagement) = "Server Admin"
case SiteManagement:
a(SiteManagement) = permission.SiteName
...
End Select
Next
WriteStuff.WriteLine Join(a, "|") ' Use Join() to combine array values
Next
Let's start with the output. You want to print a list of items (some of them possibly Empty) separated by "|". That should be done like this:
WriteStuff.WriteLine Join(aOut, "|")
Advantages:
You don't need to know that VBScript's concatenation operator is &, not +, because you can't even use the wrong one with Join.
You don't need to repeat the separator.
No useless pre/ap-pending of the empty string "".
Works with any number of items.
aOut needs to be initalized in the loop. That is easy with ReDim - without Preserve.
Advantages:
You don't need to know that Empty is the literal for empty/uninitialzed in VBScript.
You don't need to repeat an assignment for each variable.
Works with any number of items.
Demo code:
Option Explicit
Const cnUB = 3
Dim nTest
For nTest = 0 To cnUB
ReDim aOut(cnUB)
Select Case nTest
Case 0
aOut(0) = "A"
Case 1
aOut(1) = "B"
Case 2
aOut(2) = "C"
Case 3
aOut(3) = "D"
End Select
WScript.Echo Join(aOut, "|")
Next
output:
cscript 31565794.vbs
A|||
|B||
||C|
|||D
Disadvantage:
Putting the data into the array anonymously (just known by number/index) may be more errorprone than using distinct variable( name)s. If you need the elements for further computations it may be a good idea to define constants
wtf
Const ciReport = 1
...
aOut(ciReport) = "B"

Sorting data by groups in Excel

So, I've looked around and tried to solve this on my own. This isn't an absolutely crucial question currently, I just want to know if it could be done.
So let's say I've got a list with some data that looks like
Date Location
01/24/14 H-12
01/25/14 BB-44
01/30/14 G-12
01/29/14 7A-55
01/28/14 NN-15
01/24/14 GG-47
What I want is to be able to sort the data by Location, but I don't want it to be the general way, otherwise I'll end up with 7A-55, BB-44, G-12, H-12, NN-15. I want the data to be sorted so that double letters and single letters are sorted together. E.G. it should be G-12, H-12, BB-44, NN-15, 7A-55 once everything has been sorted.
I've tried creating a custom list sort, but it doesn't work. the way intended. The custom list I tried was A-Z, AA-ZZ, 7A (items were listed out, but for saving space I wrote them like that).
Like I said, this isn't a particularly huge deal if it can't be done, it just would have made it a little easier.
Edit 1 Here is what I would like to be the output
Date Location
01/30/12 G-12
01/24/14 H-12
01/25/14 BB-44
01/24/14 GG-47
01/28/14 NN-15
01/29/14 7A-55
Edit
All of these worked in the regards i wanted to, although if I had to choose a favorite it would be the base 36 number conversion one. That was some real out-of-the-box thinking and the math geek in me appreciated it. Thanks everyone!
Well it works, but is a bit complex, so rather just for fun:
This UDF returns a value that can be used as sort key. It transforms the code into a four-digit base 36-number, i.e. using A-Z and 0-9 as symbols (like hex uses 0-9 and A-F). To get at your desired output, I literally put the symbols in this order, letters first (so "A" = 0 and "0" = 26).
(The missing 'digits' are filled up with zeros, which are in this case "A"s)
It works ;)
Public Function Base36Transform(r As Range) As Long
Dim s As String, c As String
Dim v
Dim i As Integer
Dim rv As Long
v = Split(r.Text, "-")
s1 = v(0)
s2 = v(1)
s = Right("A" & s1, 2) & Right("A" & s2, 2)
rv = 0
For i = 1 To Len(s)
c = Mid(s, Len(s) - i + 1, 1)
If c Like "#" Then
rv = rv + (Val(c) + 26) * (36 ^ (i - 1))
Else
' c is like "[A-Z]"
rv = rv + (Asc(c) - Asc("A")) * (36 ^ (i - 1))
End If
Next
Base36Transform = rv
End Function
Sorting is often a very creative process. VBA can ease up the process, but a little extension of the data will work just as well.
See my results:
The way I did it is by getting the length of each string, just to be safe. This is gotten by simply going =LEN(B2), dragged down.
Then I check if it starts with 7. If it does, assign 1, otherwise keep at 0. I used this formula: =(LEFT(B2,1)="7")*1, dragged down.
Now, my custom sort is this:
Now I might have gotten some things wrong here, or I might even have done overkill by going the Length column. However, the logic is pretty much what you're aiming for.
Hope this helps in a way! Let us know. :)
I am a little lazy here and assuming your data sits in Column A,B. You mightneed to adjust your range or the starting point of your list. But here's the code:
Sub sortttttt()
Dim rng As Range
Dim i As Integer
Range("B2").Activate
Do While Not IsEmpty(ActiveCell)
ActiveCell.Value = Len(ActiveCell.Value) & ActiveCell.Value
ActiveCell.Offset(1, 0).Activate
Loop
Set rng = Range("A1:B6")
rng.Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlYes
Range("B2").Activate
Do While Not IsEmpty(ActiveCell)
ActiveCell.Value = Right(ActiveCell.Value, Len(ActiveCell.Value) - 1)
ActiveCell.Offset(1, 0).Activate
Loop
End Sub
Assuming your data is in columns B:C with labels in Row1 and no intervening blank rows, add a column with:
=IF(ISNUMBER(VALUE(LEFT(C2))),3,IF(FIND("-",C2)>2,2,1))
in D1 copied down to suit and sort ascending Location within sort ascending of the added column.

Count what number that appears the most. In VBScript

I got this comma separated file with a bunch of numbers
The only thing that I need to be able to do is to find what number that appears the most time
Ex:
817;9;516;11;817;408;9;817
then the result will be 817
I hope you understand what I am trying to do.
I would suggest using the FileSystemObjects, specifically the OpenTextFile method to read the file, then use split function to separate based on columns. Then iterate the array returned, and count the number of times each number occurs.
The following code will count your array for you. It uses the useful Dictionary object.
Set counts = CreateObject("Scripting.Dictionary")
For i = Lbound(arr) to Ubound(arr)
If Not counts.Exists(arr(i)) Then
counts.add arr(i), 1
Else
currCount = counts.Item(arr(i))
counts.Item(arr(i)) = currCount + 1
End If
Next
nums = counts.Keys()
currMax = 0
currNum = 0
For i = Lbound(nums) to Ubound(nums)
If counts.Item(nums(i)) > currMax Then
currMax = counts.Item(nums(i))
currNum = nums(i)
End If
Next
num = currNum ' Most often found number
max = currMax ' Number of times it was found
i would go through the text and count the number of your nubmers.
after that i would redim an dynamic array.
- go throught the text from beginning to end, and store them in the array.
after that i would pick the first number, go through the array and count (for example in tmpcounter) the number of dublicates. [you could store the counted number from the textfile in tmphit]
the you pick the second number, count the number of dublicates ( tmpcounter2 /tmphit2)
compare the two counters,you "keep" the higher one and use the lowe one for the next number
...go on until the last field is validated.
at the end you know which number appearse most and how often.
i hope this help you.
this is how i would programm it, maybe there is a better way or an API.
at the end you know
Try this
Set objFile = CreateObject("Scripting.FileSystemObject").OpenTextFile("C:\Test.txt",1)
Set dictNumbers = CreateObject("Scripting.Dictionary")
Dim MostKey
intHighest = -1
do while NOT objFile.AtEndOfStream
LineArray = Split(objFile.ReadLine,";")
for i = 0 to UBound(LineArray)
if dictNumbers.Exists(LineArray(i)) Then
dictNumbers.Item(LineArray(i)) = dictNumbers.Item(LineArray(i)) + 1
else
dictNumbers.Add LineArray(i), 1
end if
if dictNumbers.Item(LineArray(i)) > intHighest Then
intHeighest = dictNumbers.Item(LineArray(i))
MostKey = LineArray(i)
end if
next
Loop
MsgBox MostKey

Resources