I have a string of data in the form "X0507Y0512Z0413". I am using VB to read the data from a pic microcontroller, and load the data into excel using VB script found on web. I can get the first line of data into the first cell of my spreadsheet in the form as above. However I wish to separate this string into three columns X,Y & Z and drop the letter from the beginning of each variable. It would also have to read in up to 20 seconds of data at a time so each value would need to be appended to the previous. Here is my VB script thus far, I have tried the Split() command and received an Error 13 type mismatch.
Private Sub CommandButton3_Click()
Dim intPortID As Integer ' Ex. 1, 2, 3, 4 for COM1 - COM4
Dim lngStatus As Long
Dim strData As String
Dim xyzData As String
intPortID = 4
lngStatus = CommRead(intPortID, strData, 1)
xyzData = Split(strData, "X""Y""Z")
Range("A2,B2,C2").Value = xyzData
End Sub
I am a total novice so this may be quite a simple fix, so apologies if it seems trivial. Any suggestions would be great.
S.J
PS
Would it be made simpler if each variable were separated by a comma?
The first problem is that xyzData is set to be a string. As you're populating it from a Split you need an array:
Dim xyzData() as String
I can't think of an easy way to do the splitting in VBA as you're splitting by a different character each time - its needs a bespoke function to handle it. The following works - my VBA is a little rusty, so it might be possible to make it neater, but I think it works:
Private Function SplitXYZ(strData As String) As String()
Dim pos1 As Integer
Dim pos2 As Integer
Dim char As String
Dim i As Integer
Dim ret() As String
Dim retCount As Integer
ReDim ret(0)
For i = 1 To Len(strData)
'Get and check the character from the string
char = Mid(strData, i, 1)
If char = "X" Or char = "Y" Or char = "Z" Then
'Set the positions for the new range
pos1 = pos2
pos2 = i
'If the range is valid then add to the results
If pos1 > 0 Then
ReDim Preserve ret(retCount)
ret(retCount) = Mid(strData, pos1 + 1, pos2 - pos1 - 1)
retCount = retCount + 1
End If
End If
Next i
'Add any final string
ReDim Preserve ret(retCount)
ret(retCount) = Mid(strData, pos2 + 1, Len(strData) - pos2)
SplitXYZ = ret
End Function
Using it is as simple as:
Private Sub Test()
Dim strData As String
Dim xyzData() As String
strData = "X0507Y0512Z0413"
xyzData = SplitXYZ(strData)
End Sub
How you then use the split array is up to you.
One other thing: If you can assume that each piece of data in your string is the same length (ie 4 digits with the letter in front) then breaking the string down by length might be simpler, but you've not specified that this is the case, so I've not assumed it.
Related
I have a list of serial numbers I need to cycle through in a macro. Most of the serial numbers are consecutive, but occasionally a few will be missing. For example, I might need to use serial numbers 500-510, 512-513, 516.
Is there a way to loop through a list like that? I'd really prefer not to have to write out every number, ex: 500, 501, 502, 503... because sometimes I could have hundreds of serial numbers.
Also, the list will change with every run, so I need to be able to ask the user for the list of serial numbers and then insert that list into the vba macro. Not sure how to do that.
Thanks.
If it doesn't get much more complicated than your sample string one could refer to a Range object, e.g.:
Sub Test()
Dim str As String: str = "500-510,512-513,516"
For Each i In Range("A" & Replace(Replace(str, "-", ":A"), ",", ",A"))
Debug.Print i.Row
Next
End Sub
It may be obvious there are limitations to this approach (both length-wise on concatenating a string that represents a Range, but also on potential numbers not represented through rows on a worksheet.
Maybe a little more solid would be:
Sub Test()
Dim str As String: str = "500-510,512-513,516"
For Each el In Split(str, ",")
If InStr(1, el, "-") > 0 Then
For x = Val(el) To Val(Right(el, InStrRev(el, "-") - 1))
Debug.Print x
Next
Else
Debug.Print Val(el)
End If
Next
End Sub
As for your input string validation; You could look into Like operator or better, regular expressions.
You'll need a function that accepts a string such as "500-510,512-513,516" and returns an array of numbers represented by that expression. I haven't fully tested the below, but it appears to do the job:
Code
Function ParseNonContiguousRange(rangeExpr As String) As Long()
Dim tokens As Variant, token As Variant
Dim rangeStart As Long, rangeEnd As Long, count As Long, i As Long, index As Long
tokens = Split(rangeExpr, ",")
'First pass: count numbers in range
For Each token In tokens
If InStr(token, "-") Then
rangeStart = CLng(Split(token, "-")(0))
rangeEnd = CLng(Split(token, "-")(1))
count = count + rangeEnd - rangeStart
Else
count = count + 1
End If
Next token
Dim result() As Long
ReDim result(count + 1)
'Second pass: populate range
For Each token In tokens
If InStr(token, "-") Then
rangeStart = CLng(Split(token, "-")(0))
rangeEnd = CLng(Split(token, "-")(1))
For i = rangeStart To rangeEnd
result(index) = i
index = index + 1
Next i
Else
result(index) = CLng(token)
index = index + 1
End If
Next token
ParseNonContiguousRange = result
End Function
Sub TestParseNonContiguousRange()
Dim output() As Long
output = ParseNonContiguousRange("500-510,512-513,516")
For Each i In output
Debug.Print i
Next i
End Sub
Output
500
501
502
503
504
505
506
507
508
509
510
512
513
516
Get an array of numbers in different sequences
In addition to JvDv's valid answer an alternative approach assigning items to a 0-based 1-dim array which could be used for further processing:
Sub GetArrayOfNumbers()
Dim numbers As String: numbers = "500-510,512-513,516"
ReDim tmp(10000) ' provide for enough items in temp array
Dim number
For Each number In Split(numbers, ",") ' check each number or pair of numbers
Dim pair: pair = Split(number & "-" & number, "-")
Dim i As Long, counter As Long
For i = Val(pair(0)) To Val(pair(1))
tmp(counter) = i: counter = counter + 1 ' add number to temporary array
Next
Next number
ReDim Preserve tmp(0 To counter - 1) ' reduce to exact items count
Debug.Print Join(tmp, ",") ' (optional) display in VB Editor's Immediate Window
' ~> 500,501,502,503,504,505,506,507,508,509,510,512,513,516
End Sub
Methodical hints
In order to avoid distinguishing between single numbers and a number range, I changed any number token to a pair of numbers by re-adding the same token (prefixed by "-") to itself which simplifies splitting and the eventual assignment loop.
So splitting the last token "516-516" will allow to collect the relevant array item in a single loop step, whereas the additional appendix doesn't matter in the actual pairs of numbers (as splitting the redundant string "500-510-500-510" results in a correct values pair(0) = 500 and pair(1)=510, too).
Above is a simplified example but what I want to achieve with my UDF is to accept the string in the Collated column and a delimiter which will be used to break the sting apart into substrings and be assigned sequentially to the columns Q1, Q2, Q3, Q4. It is possible for there to be less than 4 substrings generated but there will never be more than 4.
Function DECONS(Subject As String, Delim As String) As String
' takes an input string "Subject" and seperates it using "Delim" as the deliminator
' If the desired element exceeds the number of unique substrings the function returns a blank result
' Hardcoded for max 4 substrings
' initializes temporary variables
Dim i As Long
Dim r() As String
' uses built in VBA function to split the passed string using the deliminating character
r = Split(Subject, Delim)
' increases the size of r() to 4 elements and fills extra elements with blancks
For i = UBound(r) + 1 To 3
ReDim Preserve r(i)
r(i) = ""
Next i
' my sad attempt at what I want to acheive
Dim loT As ListObject
Set loT = ThisWorksheet.ListObjects("TT")
For i = 1 To 4
loT.ListColumn(i + 1).Range.Value = r(i - 1)
Next i
End Function
I've done the text manipulation using the VBA split function which yields an array of strings but I'm hitting a wall as to how to assign the substrings to the relevant columns. My attempt can be seen above. I've done a fair bit of reading but I'm still not comfortable enough in VBA/Excel to figure this out on my own yet. Is this more complex when in a ListObject than outside a table object?
Unfortunately I can't return the string array from the function and then assign it to multiple cells as the Table Object doesn't allow array operations. I had a work around where I would return a specified element, ie the 3rd, and I would call the function in each column and output the one corresponding value. However, the method is not elegant and does a lot of unnecessary repeated computation.
Try
Sub DECONS(Delim As String)
Dim objList As ListObject
Dim vDB As Variant, vSplit
Dim vR(), n As Integer, r As Long
Dim i As Long
Set objList = ActiveSheet.ListObjects("TT")
vDB = objList.DataBodyRange.Columns(1)
r = UBound(vDB, 1)
ReDim vR(1 To r, 1 To 4)
For i = 1 To r
vSplit = Split(vDB(i, 1), "\")
n = 0
For Each v In vSplit
n = n + 1
vR(i, n) = v
Next v
Next i
'Range("b2").Resize(r, 4) = vR
objList.DataBodyRange.Columns(2).Range("a1").Resize(r, 4) = vR
End Sub
I have a code that generates random strings of characters (passwords) that contain exactly 8 characters. My issue is that it populates only numbers and characters.
1) I would like to include special characters to the mix and to make sure at least one special character is always included in each string.
2) I need to add a condition that each string always contains at least one upper case character, at least one lower case, at least one number.
This is the code I have but I can't figure out how to include these conditions to make it work as I need. I've tried a lot of googling to make it work specifically for this code but can't figure it out. Can you please advise?
Sub MakeRandom()
Dim J As Integer
Dim K As Integer
Dim L As Double
Dim iTemp As Integer
Dim sNumber As String
Dim bOK As Boolean
Range("G5:G148").Activate
Randomize
L = InputBox("Amount of Passwords:")
For J = 1 To L
sNumber = ""
For K = 1 To 8
Do
iTemp = Int((122 - 48 + 1) * Rnd + 48)
Select Case iTemp
Case 48 To 57, 97 To 122
bOK = True
Case Else
bOK = False
End Select
Loop Until bOK
bOK = False
sNumber = sNumber & Chr(iTemp)
Next K
ActiveCell.Value = sNumber
ActiveCell.Offset(1, 0).Select
Next J
End Sub
I'd appreciate any useful advice.
Why not introduce Long string, containing all legal characters and then having your algo pick chars from random positions of this string? That way you have easy control of what can be in your Passwords.
To ensure the conditions are true, I would place the Password Generation in an infinite Loop, that only end when all conditions are satisfied. As Long as this this is actually possible (that is, your conditions can all be true at the same time), this Loop will eventually end (due to law of large numbers).
I have something that might help you. I use a different method but the result should be similar. I've adapted it to your constraints, but may have missed something.
Mine works like this: I have a sheet called ChrSrc with all characters that I want to be able to include in the string. The characters have been divided into four columns. From column A to D it's lower case letters, upper case letters, numbers, special characters.
An array is made to store the characters and create the random string. The array contains 3 'columns'. the first gives a number between 1 and 4 to determine from which column it should get it's character. The first four are always 1,2,3,4 to makes sure every type of character is used at least once. The other 4 (or more if the random string is longer) are randomly filled.
The second 'column' is then filled with the actual character to add to the random string. And lastly the third 'column' is filled with zeros. These will be used to track which characters have been used in the random string.
Once the array has been filled, the do while loop is used to select the order of the characters randomly. After a character has been added, the zero in the array is changed to a one, to make sure every character gets used once.
By the end your random string is in the variable RandomString and you can write it to a cell or do whatever with it.
If you want to create multiple strings in one go, I would suggest writing a small caller sub, that calls this one x amount of times. Or add a loop and inputbox into this one.
Hope that helps.
Sub CreateString()
Dim StringArray() As Variant
Dim PositionCount As Long
Dim Lr As Long
Dim RandomString As String
Dim arrIndex As Long
Dim Loopcount As Long
Dim StringLength As Long
StringLength = 8
ReDim StringArray(1 To StringLength, 1 To 3)
For PositionCount = 1 To StringLength
If PositionCount > 4 Then
StringArray(PositionCount, 1) = Random(4)
Else
StringArray(PositionCount, 1) = PositionCount
End If
'lastrow for each character category, adjust as needed
Select Case StringArray(PositionCount, 1)
Case Is <= 2
Lr = 26
Case Is = 3
Lr = 10
Case Is = 4
Lr = 17
End Select
StringArray(PositionCount, 2) = ThisWorkbook.Sheets("ChrSrc").Cells(Random(Lr), StringArray(PositionCount, 1))
StringArray(PositionCount, 3) = 0
Next
Do While Len(RandomString) < StringLength
arrIndex = Random(StringLength)
If StringArray(arrIndex, 3) = 0 Then
RandomString = RandomString & StringArray(arrIndex, 2)
StringArray(arrIndex, 3) = 1
End If
Loopcount = Loopcount + 1
Loop
End Sub
Function Random(Max As Long)
Random = Int(Max * Rnd) + 1
End Function
Where possible, it's advisable to avoid using Activate and Select. In your case, you could create an array of random strings and then write the array to the sheet. The length of the array could be controlled by the value returned by InputBox.
Your code may benefit from: L = InputBox("Amount of Passwords:", Type:=1) which, if I'm reading the documentation correctly, validates that the input is numeric.
My understanding is that you should use type Long instead of Integer under normal circumstances (as Integers are now converted to Longs under the hood). Moreover, in this context where you're receiving arbitrary user input, Integer type overflows at 32768. If you enter 32768 (for example) or any larger number into the InputBox you should see an unhandled overflow error.
With reference to the approach described in this answer (https://stackoverflow.com/a/57903244/8811778):
Option Explicit
Private Function CreateRandomString(Optional ByVal lengthOfOutput As Long = 8, Optional ByVal minimumCountOfNumbers As Long = 1, Optional ByVal minimumCountOfLetters As Long = 1, Optional ByVal minimumCountOfSymbols As Long = 1) As String
Dim countRemaining As Long
countRemaining = lengthOfOutput - (minimumCountOfLetters + minimumCountOfNumbers + minimumCountOfSymbols)
Debug.Assert countRemaining >= 0
Const LETTERS_ALLOWED As String = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
Const NUMBERS_ALLOWED As String = "0123456789"
Const SYMBOLS_ALLOWED As String = "!""£$%^&*()-_+[]{};:'##" ' Change as necessary, I do not know what symbols you want included.
Dim toJoin() As String
ReDim toJoin(1 To 4)
toJoin(1) = GetRandomCharactersFromText(LETTERS_ALLOWED, minimumCountOfLetters, duplicatesAllowed:=False)
toJoin(2) = GetRandomCharactersFromText(NUMBERS_ALLOWED, minimumCountOfNumbers, duplicatesAllowed:=False)
toJoin(3) = GetRandomCharactersFromText(SYMBOLS_ALLOWED, minimumCountOfSymbols, duplicatesAllowed:=False)
' I arbitrarily pad the rest of the string with random letters, but you can change this logic.
toJoin(4) = GetRandomCharactersFromText(LETTERS_ALLOWED, countRemaining, duplicatesAllowed:=False)
Dim outputString As String
outputString = Join(toJoin, vbNullString)
' This step is meant to scramble the characters in the string.
' Otherwise, the returned string's structure would reflect the code above:
' • w letters, followed by x numbers, followed by y symbols, followed by z characters
' which stops it being pseudo-random.
outputString = GetRandomCharactersFromText(outputString, Len(outputString), False)
CreateRandomString = outputString
End Function
Private Function RandomBetween(ByVal lowerLimit As Long, ByVal upperLimit As Long) As Long
' Could use Application.RandBetween instead (maybe). But maybe there is some performance difference.
' https://learn.microsoft.com/en-us/office/vba/language/reference/user-interface-help/rnd-function
RandomBetween = Int((upperLimit - lowerLimit + 1) * Rnd + lowerLimit)
End Function
Private Function GetRandomCharactersFromText(ByVal someText As String, ByVal numberOfCharactersToGet As Long, Optional ByVal duplicatesAllowed As Boolean = True) As String
' Returns n characters from a given string. Characters are chosen pseudo-randomly.
' "duplicatesAllowed" controls whether a given index can be chosen more than once.
Dim chosenIndexes() As Long
ReDim chosenIndexes(1 To numberOfCharactersToGet)
Dim characterIndex As Long
For characterIndex = 1 To numberOfCharactersToGet
Do While True
Dim randomCharacterIndex As Long
randomCharacterIndex = RandomBetween(1, Len(someText))
If duplicatesAllowed Then Exit Do
If IsError(Application.Match(randomCharacterIndex, chosenIndexes, 0)) Then Exit Do
Loop
chosenIndexes(characterIndex) = randomCharacterIndex
Next characterIndex
Dim chosenCharacters() As String
ReDim chosenCharacters(1 To numberOfCharactersToGet)
For characterIndex = 1 To numberOfCharactersToGet
randomCharacterIndex = chosenIndexes(characterIndex)
chosenCharacters(characterIndex) = Mid(someText, randomCharacterIndex, 1)
Next characterIndex
GetRandomCharactersFromText = Join(chosenCharacters, vbNullString)
End Function
This is just my interpretation of the approach posted by the user. That user may have implemented their approach differently.
Majority of the work is done by the GetRandomCharactersFromText function.
You can probably get rid of the nested For K = 1 to 8 loop and replace with something like ActiveCell.Value = CreateRandomString(lengthOfOutput:=8, minimumCountOfNumbers:=1, minimumCountOfSymbols:=1) (although you should avoid using ActiveCell and, in general, relying on objects to be active).
Lastly, based on certain parts of your code, it seems this code is meant to generate passwords. I'm no security expert so I will refrain from providing security-related suggestions/advice. You may or may not benefit from reading https://xkcd.com/936/ and the related discussion https://security.stackexchange.com/a/6096/71460.
I have asked here to how put %u after every four digit to convert my long string into a proper unicode text. I got a very nice reply with the UDF and it work great.. now from this string
002006390632064A0632064A00200627064406390645064A0644003A0020062A0645002006270644
I am able to convert it into
%u0020%u0639%u0632%u064A%u0632%u064A%u0020%u0627%u0644%u0639%u0645%u064A%u0644%u003A%u0020%u062A%u0645%u0020%u0627%u0644
Well the string is to long i just showed you the result... Now what I am looking is there any excel function which can convert this into Arabic text. Actually its a uncode and want to see how it look in Arabic.
Currently I am using a website
http://unicode.online-toolz.com/tools/text-unicode-entities-convertor.php
to convert it manually. Is there any excel function which can do that locally.
You could create a byte array from the code and assigning this byte array to a String. This String can then be assigned to a Cell.
Example:
Sub test()
Dim sCode As String
sCode = "002006390632064A0632064A00200627064406390645064A0644003A0020062A0645002006270644"
Dim b() As Byte
Dim j As Long
j = 0
For i = 1 To Len(sCode) Step 4
ReDim Preserve b(j + 1)
b(j) = Val("&H" & Mid(sCode, i + 2, 2))
b(j + 1) = Val("&H" & Mid(sCode, i, 2))
j = j + 2
Next
Dim s As String
s = b
Range("A1").Value = s
End Sub
How is it possible to split a VBA string into an array of characters?
I tried Split(my_string, "") but this didn't work.
Safest & simplest is to just loop;
Dim buff() As String
ReDim buff(Len(my_string) - 1)
For i = 1 To Len(my_string)
buff(i - 1) = Mid$(my_string, i, 1)
Next
If your guaranteed to use ansi characters only you can;
Dim buff() As String
buff = Split(StrConv(my_string, vbUnicode), Chr$(0))
ReDim Preserve buff(UBound(buff) - 1)
You can just assign the string to a byte array (the reverse is also possible). The result is 2 numbers for each character, so Xmas converts to a byte array containing {88,0,109,0,97,0,115,0} or you can use StrConv
Dim bytes() as Byte
bytes = StrConv("Xmas", vbFromUnicode)
which will give you {88,109,97,115} but in that case you cannot assign the byte array back to a string. You can convert the numbers in the byte array back to characters using the Chr() function
Here's another way to do it in VBA.
Function ConvertToArray(ByVal value As String)
value = StrConv(value, vbUnicode)
ConvertToArray = Split(Left(value, Len(value) - 1), vbNullChar)
End Function
Sub example()
Dim originalString As String
originalString = "hi there"
Dim myArray() As String
myArray = ConvertToArray(originalString)
End Sub
According to this code golfing solution by Gaffi, the following works:
a = Split(StrConv(s, 64), Chr(0))
the problem is that there is no built in method (or at least none of us could find one) to do this in vb. However, there is one to split a string on the spaces, so I just rebuild the string and added in spaces....
Private Function characterArray(ByVal my_string As String) As String()
'create a temporary string to store a new string of the same characters with spaces
Dim tempString As String = ""
'cycle through the characters and rebuild my_string as a string with spaces
'and assign the result to tempString.
For Each c In my_string
tempString &= c & " "
Next
'return return tempString as a character array.
Return tempString.Split()
End Function
To split a string into an array of sub-strings of any desired length:
Function charSplitMulti(s As Variant, splitLen As Long) As Variant
Dim padding As Long: padding = 0
Dim l As Long: l = 0
Dim v As Variant
'Pad the string so it divides evenly by
' the length of the desired sub-strings
Do While Len(s) Mod splitLen > 0
s = s & "x"
padding = padding + 1
Loop
'Create an array with sufficient
' elements to hold all the sub-strings
Do Until Len(v) = (Len(s) / splitLen) - 1
v = v & ","
Loop
v = Split(v, ",")
'Populate the array by repeatedly
' adding in the first [splitLen]
' characters of the string, then
' removing them from the string
Do While Not s Like ""
v(l) = Mid(s, 1, splitLen)
s = Right(s, Len(s) - splitLen)
l = l + 1
Loop
'Remove any padding characters added at step one
v(UBound(v)) = Left(v(UBound(v)), Len(v(UBound(v))) - padding)
'Output the array
charSplitMulti = v
End Function
You can pass the string into it either as a string:
Sub test_charSplitMulti_stringInput()
Dim s As String: s = "123456789abc"
Dim subStrLen As Long: subStrLen = 4
Dim myArray As Variant
myArray = charSplitMulti(s, subStrLen)
For i = 0 To UBound(myArray)
MsgBox myArray(i)
Next
End Sub
…or already declard as a variant:
Sub test_charSplitMulti_variantInput()
Dim s As Variant: s = "123456789abc"
Dim subStrLen As Long: subStrLen = 5
s = charSplitMulti(s, subStrLen)
For i = 0 To UBound(s)
MsgBox s(i)
Next
End Sub
If the length of the desired sub-string doesn't divide equally into the length of the string, the uppermost element of the array will be shorter. (It'll be equal to strLength Mod subStrLength. Which is probably obvious.)
I found that most-often I use it to split a string into single characters, so I added another function, so I can be lazy and not have to pass two variables in that case:
Function charSplit(s As Variant) As Variant
charSplit = charSplitMulti(s, 1)
End Function
Sub test_charSplit()
Dim s As String: s = "123456789abc"
Dim myArray As Variant
myArray = charSplit(s)
For i = 0 To UBound(myArray)
MsgBox myArray(i)
Next
End Sub
Try this minicode From Rara:
Function charSplitMulti(TheString As Variant, SplitLen As Long) As Variant
'Defining a temporary array.
Dim TmpArray() As String
'Checking if the SplitLen is not less than one. if so the function returns the whole string without any changing.
SplitLen = IIf(SplitLen >= 1, SplitLen, Len(TheString))
'Redefining the temporary array as needed.
ReDim TmpArray(Len(TheString) \ SplitLen + IIf(Len(TheString) Mod SplitLen <> 0, 1, 0))
'Splitting the input string.
For i = 1 To UBound(TmpArray)
TmpArray(i) = Mid(TheString, (i - 1) * SplitLen + 1, SplitLen)
Next
'Outputing the result.
charSplitMulti = TmpArray
End Function