In an Access Form I can enter values in a TextBox called LenD. Sometimes I need to check the input code in order to split standard text from a code. For instance:
noumnoum[codecode]
To obtain:
noumnoum
So that, I use this:
If InStr(1, Me!LenD, "[") Then
Me!LenD = Left(Mid(Me!LenD, InStr(1, Me!LenD, "[") + 1, (InStr(1, Me!LenteD, "]")) - (InStr(1, Me!LenD, "[")) - 1), 50)
Else
Me!LenD = Left(Me!LenD, 50)
End If
But I just obtain the string inside the "[" "]". My aim would be to obtain the string that is on the left of the original String. Any idea on why it does not work?
You can use Split and simplify this:
If Not IsNull(Me!LenD) Then
Me!LenD = Left(Split(Me!LenD, "[")(0), 50)
End If
Dim x as Long
x = Instr(me!LenD,"[")
If x > 0 then
Me!LenD = Left(Me!lenD,x-1)
Else
me!LenD = Left(Me!LenD,50)
End If
Related
I'm trying to check whether the main string contains the entire substring, even if there are interruptions.
For example:
main string = 12ab34cd,
substring = 1234d
should return a positive, since 1234d is entirely contained in my main string, even though there are extra characters.
Since InStr doesn't take wildcards, I wrote my own VBA using the mid function, which works well if there are extra characters at the start/end, but not with extra characters in the middle.
In the above example, the function I wrote
works if the main string is ab1234dc,
but not if it's 12ab34cd.
Is there a way to accomplish what I'm trying to do using VBA?
Note Both of the methods below are case sensitive. To make them case insensitive, you can either use Ucase (or Lcase) to create phrases with the same case, or you can prefix the routine with the Option Compare Text statement.
Although this can be done with regular expressions, here's a method using Mid and Instr
Option Explicit
Function ssFind(findStr, mainStr) As Boolean
Dim I As Long, J As Long
I = 1: J = 1
Do Until I > Len(findStr)
J = InStr(J, mainStr, Mid(findStr, I, 1))
If J = 0 Then
ssFind = False
Exit Function
End If
I = I + 1: J = J + 1
Loop
ssFind = True
End Function
Actually, you can shorten the code further using Like:
Option Explicit
Function ssFind(findStr, mainStr) As Boolean
Dim I As Long
Dim S As String
For I = 1 To Len(findStr)
S = S & "*" & Mid(findStr, I, 1)
Next I
S = S & "*"
ssFind = mainStr Like S
End Function
Assuming you have 3 columns "SUBSTR","MAIN" and "CHECK" and your "Substring" data range is named "SUBSTR"
Sub check_char()
Dim c As Range
For Each c In Range("SUBSTR")
a = 1
test = ""
For i = 1 To Len(c.Offset(0, 1))
If Mid(c.Offset(0, 1), i, 1) = Mid(c, a, 1) Then
test = test & Mid(c.Offset(0, 1), i, 1)
a = a + 1
End If
Next i
If test = c Then
c.Offset(0, 2) = "MATCH"
Else
c.Offset(0, 2) = "NO MATCH"
End If
Next
End Sub
What I need to do is to basically write lessons number. There are 3 colomns.
The second column is running by a custom formula called LessonsLeft done by someone from my second thread on stackoverflow and it is
Function LessonsLeft(rng As Range) As String
If rng.Count > 1 Then Exit Function
Dim spltStr() As String
Dim i As Long
spltStr = Split(rng.Value, ",")
LessonsLeft = ",1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,50,"
For i = LBound(spltStr) To UBound(spltStr)
LessonsLeft = Replace(LessonsLeft, "," & spltStr(i) & ",", ",")
Next i
LessonsLeft = Mid(LessonsLeft, 2, Len(LessonsLeft) - 2)
End Function
What I need to do is to add another, third colomn which is for lessons that my students did their first attempt but they couldnt pass exam.
How i want the data to be there, is to write for exemple a "-" or "+" near a number in first column so the number will move to third column.
How can it be done ?
use this function
Function LessonsAttemptedButNotDone(rng As Range) As String
If rng.Count > 1 Then Exit Function
Dim spltStr() As String, lessonDone As String
Dim i As Long
spltStr = Split(rng.Value, ",")
For i = LBound(spltStr) To UBound(spltStr)
lessonDone = spltStr(i)
If Right(lessonDone, 1) = "-" Then
lessonDone = Left(lessonDone, Len(lessonDone) - 1)
LessonsAttemptedButNotDone = LessonsAttemptedButNotDone & lessonDone & ","
End If
Next
If LessonsAttemptedButNotDone <> "" Then LessonsAttemptedButNotDone = Left(LessonsAttemptedButNotDone, Len(LessonsAttemptedButNotDone) - 1)
End Function
I am trying to delete part of the string. For example
mystring="site, site text, sales "
I want to remove 'site' from mystring. My required output is "site text, sales"
I use this line of code :
s1 = Replace(mystring, "site", "")
but i am getting "text, sales"
I am not sure how to do this and I'd really appreciate your help!
replace("site, site text, sales ","site, ","",1,1)
You can also send as a parameter the start position and then the number of times you want to replace... (the default is -1)
There are a lot of different options here :
Just by adding the coma in the search string to be replaced and use Trim to get rid of spaces :
s1 = Trim(Replace(mystring, "site,", ""))
Specify the number of time you want the string to be replaced (first "1" is the start, the second for the number of replacements)
s1 = Trim(Replace(mystring, "site,", "",1,1))
Or the hard/bad way, to decompose your string in two pieces after the first occurence and then recombine to get result...
TempStart = Left(mystring, InStr(1, mystring, "site") + Len(mystring) + 1)
TempEnd = Replace(mystring, TempStart, "")
TempStart = Replace(TempStart, "site", "")
mystring = CStr(TempStart & TempEnd)
You can also user VB's MID function like this:
Mystring=Mid(myString, 6)
output will be "site text, sales"
Just specify the number of characters you want to be removed in the number part.
In my case I wanted to remove the part of the strings that was between "[" and "]". And the following code worked great.
So With original string in column A (and solution in column B):
Sub remove_in_string()
Dim i, lrowA, remChar As Long
Dim mString As String
lrowA = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To lrowA
mString = Cells(i, 1).Value
If InStr(mString, "[") > 0 Then
remChar = InStr(mString, "]") - InStr(mString, "[") + 1
Cells(i, 2).Value = Left(mString, Len(mString) - remChar)
ElseIf InStr(mString, "[") = 0 Then
Cells(i, 2).Value = Cells(i, 1).Value
End If
Next
End Sub
Given a string containing:
property myprop1="test" myprop2="testing again" myprop3="another test"
What is the easiest way to get into a string array:
property
myprop1="test"
myprop2="testing again"
myprop3="another test"
Splitting into a 2 dimension array would be even better:
property
myprop1 test
myprop2 testing again
myprop3 another test
My original plan was to run the split function with a space delimiter on the string. This works if there are no spaces embedded in the value portion of the name-value pair, which (of course) do contain spaces.
Some conditions:
This code needs to execute in Excel 2010 VBA. I don't want to have to add third-party references or a bunch of toolkits. I'm not looking for elegant or IEEE examples. I need maintainable and understandable production code.
Thanks in advance for any and all assistance!
EDIT: The number of 'mypropX' are variable; there may be less or more than three.
EDIT2: I've been informed of another 'difference'. :) Turns out the value of a myprop might not be delimited by double quotes; in that case it will be a single alphanumeric string with no interior spaces.
Try this
Sub Test()
Dim strVar, Arr1, Arr2()
strVar = "property myprop1=""test"" myprop2=""testing again"" myprop3=""another test"""
Arr1 = Split(Mid(strVar, InStr(1, strVar, " ") + 1), """ ")
ReDim Arr2(UBound(Arr1) + 1)
Arr2(0) = Mid(strVar, 1, InStr(1, strVar, " ")) 'store the first string, i.e. property
'store the data with double quotes
For i = 0 To UBound(Arr1) - 1
Arr2(i + 1) = Arr1(i) & """"
Next
'store the last string
Arr2(i + 1) = Arr1(i)
For i = 0 To UBound(Arr2)
MsgBox Arr2(i)
Next
End Sub
If you replace('="','=') then you can do a split on '" ' and this should give you:
property
myprop1=test
myprop2=testing again
myprop3=another test
This assumes that there are no " inside the quotes (which would make a mess of most attempts to parse anyway).
Then you can split the items in this array on '=' to get into a 2 element array. To account for possible = within values set the Limit parameter on Split() to 2.
Edit:
I'm feeling generous - here's some code - add your own error handling!
Public Sub ParseNVPs(ByVal str As String, ByRef ReturnArray() as String)
Dim SplitArray() As String
Dim LineArray() As String
Dim i As Integer
str = Replace(str, "=""", "=")
SplitArray = Split(str, """ ")
ReDim ReturnArray(UBound(SplitArray), 1)
For i = 0 To UBound(SplitArray)
LineArray = Split(SplitArray(i), "=", 2)
ReturnArray(i, 0) = LineArray(0)
ReturnArray(i, 1) = LineArray(1)
Next i
End Sub
Here's what I came up with. It's not elegant but it gets the job done. Thanks for the input folks, it was very helpful.
'split name value pairs into array
strWorkString = schematicLines(lngValuePosition)
lngStartPosition = 1
lngEndPosition = 1
fStartQuote = False
f1stWordDone = False
ReDim strWorkArray(0) As String
For lngLoopCounter = 1 To Len(strWorkString) - 1
strCurrentCharacter = Mid(strWorkString, lngLoopCounter, 1)
Select Case True
Case (strCurrentCharacter = " " And Not fStartQuote) 'space and we aren't in a value
If (f1stWordDone) Then
ReDim Preserve strWorkArray(UBound(strWorkArray) + 1) As String
End If
lngEndPosition = lngLoopCounter
strWorkArray(UBound(strWorkArray)) = Trim(Mid(strWorkString, lngStartPosition, lngEndPosition - lngStartPosition))
lngStartPosition = lngEndPosition + 1
lngEndPosition = lngStartPosition
f1stWordDone = True
Case strCurrentCharacter = Chr$(34) 'double quote
If fStartQuote Then 'in a value
'store the nvp
lngEndPosition = lngLoopCounter
ReDim Preserve strWorkArray(UBound(strWorkArray) + 1) As String
strWorkArray(UBound(strWorkArray)) = Trim(Mid(strWorkString, lngStartPosition, lngEndPosition - lngStartPosition + 1))
lngLoopCounter = lngLoopCounter + 1 'skip the space
lngStartPosition = lngLoopCounter
lngEndPosition = lngStartPosition
fStartQuote = False
Else
fStartQuote = True
End If
End Select
Next lngLoopCounter
' get the last nvp
ReDim Preserve strWorkArray(UBound(strWorkArray) + 1) As String
strWorkArray(UBound(strWorkArray)) = Mid(strWorkString, lngStartPosition, lngLoopCounter - lngStartPosition + 1)
I'm working to create an Excel macro using VBA to convert bit strings to numbers. They are not binary numbers, each '1' stands for it's own number.
e.g: 1100000000000000000010001
from the left, the first bit represents "1", the second bit represents "2", third bit represents "0", and so on. The total quantity of bits in each string is 25.
I want VBA to convert it and show results like so: 1, 2, 21, 25.
I tried using Text to Columns but was not successful.
Try something like this:
Sub Execute()
Dim buff() As String
Dim i As Integer, total As Double
buff = Split(StrConv(<theString>, vbUnicode), Chr$(0))
total = 0
For i = 0 To UBound(buff)
Debug.Print (buff(i))
'total = total + buff(i) * ??
Next i
End Sub
Consider:
Public Function BitPicker(sIn As String) As String
For i = 1 To Len(sIn)
If Mid(sIn, i, 1) = 1 Then
BitPicker = BitPicker & i & ","
End If
Next
BitPicker = Mid(BitPicker, 1, Len(BitPicker) - 1)
End Function
Another non-VBA solution, based on the OP' initial approach and with a layout designed to facilitate multiple 'conversions' (ie copy formulae down to suit):
Does this have to be VBA? Give a data setup like this:
The formula in cell B4 and copied down to B33 is:
=IF(ROWS(B$3:B3)>LEN($B$1)-LEN(SUBSTITUTE($B$1,"1","")),"",FIND("#",SUBSTITUTE($B$1,"1","#",ROWS(B$3:B3))))
The formula cells are formatted as General and the the Bit String cell (B1) is formatted as Text.
Try this:
Function ConvertMyRange(Rng As Range) As String
Dim MyString As String
MyString = Rng.Text
Dim OutPutString As String
For i = 1 To Len(MyString)
If Mid(MyString, i, 1) = "1" Then OutPutString = OutPutString & ", " & i
Next i
' Get rid of first ", " that was added in the loop
If Len(OutPutString) > 0 Then
OutPutString = Mid(OutPutString, 2)
End If
ConvertMyRange = OutPutString
End Function
For your input, the output is 1, 2, 21, 25