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
Related
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 a column in Excel with the format:
A01G45B45D12
I need a way to format it like this, that is divide the string into groups of three characters, sort the groups alphabetically and then join them together with a + sign between:
A01+B45+D12+G45
I wonder it this is possible using the built in formulas in Excel or if I have to do this using VBA or something else, I already have the code for this in C# if there is an easy way to use that from Excel. I have not written plugins for Excel before.
Edit to add:
The above is just an example, the string can be of "any length" but its always divisible by three and the order is random so I cannot assume anything about the order beforehand.
Sub ArraySort()
Dim strStarter As String
Dim strFinish As String
Dim intHowMany As Integer
Dim intStartSlice As Integer
strStarter = ActiveCell.Offset(0, -1).Value 'Pulls value from cell to the left
intHowMany = Int(Len(strStarter) / 3)
ReDim arrSlices(1 To intHowMany) As String
intStartSlice = 1
For x = 1 To intHowMany
arrSlices(x) = Mid(strStarter, intStartSlice, 3)
intStartSlice = intStartSlice + 3
Next x
Call BubbleSort(arrSlices)
For x = 1 To intHowMany
strFinish = strFinish + arrSlices(x) & "+"
Next x
strFinish = Left(strFinish, Len(strFinish) - 1)
ActiveCell.Value = strFinish 'Puts result into activecell
End Sub
Sub BubbleSort(list() As String)
'Taken from power programming with VBA
'It’s a sorting procedure for 1-dimensional arrays named List
'The procedure takes each array element, if it is greater than the next element, the two elements swap positions.
'The evaluation is repeated for every pair of items (that is n-1 times)
Dim First As Integer, Last As Long
Dim i As Long, j As Long
Dim temp As String
First = LBound(list)
Last = UBound(list)
For i = First To Last - 1
For j = i + 1 To Last
If list(i) > list(j) Then
temp = list(j)
list(j) = list(i)
list(i) = temp
End If
Next j
Next i
End Sub
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.
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