Currently we have a small bit of code that gets the value of a cell and returns 4 digits of it.
For example L1234 would be 1234, D1234 would be 1234
However now we have values that are 5 digits L12345 for example and they are just being returned as the last 2 digits. e.g. L12345 is being returned as 45
What i want is to modify the code to allow for both 4 and 5 digit variants.
Current Code:
If GetElm(Range("F" & i).value, 3) = "8260" Then
CodeD = GetElm(Range("F" & i).value, 4)
End If
col9 = Right(CodeD, 4)
This returns:
Input Output
L1234 1234
L12345 45
What I have tried:
If GetElm(Range("F" & i).value, 3) = "8260" Then
CodeD = GetElm(Range("F" & i).value, 4)
ElseIf GetElm(Range("F" & i).value, 3) = "8260" Then
CodeD = GetElm(Range("F" & i).value, 5)
End If
col9 = Right(CodeD, 5)
This Returns:
Input Output
L1234 L1234
L12345 12345
This returns the 5 digit ones correctly, but the 4 digit ones are being returned with the letter.
EDIT:
GetElm Definition:
Function GetElm(value As String, elmno As Integer)
If elmno = 1 Then
GetElm = Left(value, 1)
ElseIf elmno = 2 Then
GetElm = Mid(value, 3, 3)
ElseIf elmno = 3 Then
GetElm = Mid(value, 7, 4)
ElseIf elmno = 4 Then
GetElm = Mid(value, 12, 8)
End If
End Function
If you always want to just skip the first character, you can use:
col9 = Mid(CodeD, 2)
If all you want to do is to skip the first character in the cell's value, then:
Function GetElm (byval value as string) as string
GetElm = Right(value, Len(value)-1)
End Function
should do the trick.
This assumes you always have a 1-letter, n-digits code.
Still, I don't understand the use for the second parameter in your GetElm function definition.
Regards,
Luis
Added function:
Function onlyDigits(s As String) As String
' Variables needed (remember to use "option explicit"). '
Dim retval As String ' This is the return string. '
Dim i As Integer ' Counter for character position. '
' Initialise return string to empty '
retval = ""
' For every character in input string, copy digits to '
' return string. '
For i = 1 To Len(s)
If Mid(s, i, 1) >= "0" And Mid(s, i, 1) <= "9" Then
retval = retval + Mid(s, i, 1)
End If
Next
' Then return the return string. '
onlyDigits = retval
End Function
Then used the code:
If GetElm(Range("F" & i).value, 3) = "8260" Then
CodeD = GetElm(Range("F" & i).value, 4)
End If
col9 = onlyDigits(CodeD)
Related
I am fairly new in VBA, i am working on a project, there's small problem i am facing. I am taking newLastCmtTypeCol, newLastCmtCol, newLastNoteCol, oldLastCmtTypeCol, oldLastCmtCol, oldLastNoteCol as strings and i am only calling them in this part of code. so the error happend when one of the string start with a special character. I am taking input from sheet with alot of data. there's absolutely no way i can go through all of that data all the time. I just wanna ignore the strings start with starts with special character, so i wouldnt see any error.Here is the part of the code.
Dim newLastCmtTypeCol As String
Dim newLastCmtCol As String
Dim newLastNoteCol As String
Dim oldLastCmtTypeCol As String
Dim oldLastCmtCol As String
Dim oldLastNoteCol As String
newLastCmtTypeCol = "N"
newLastCmtCol = "O"
newLastNoteCol = "P"
oldLastCmtTypeCol = "Q"
oldLastCmtCol = "R"
oldLastNoteCol = "S"
For j = 0 To indexNew(i, 4)
If (StrComp(ws1.Range(newLastCmtTypeCol & i + j), ws1.Range(oldLastCmtTypeCol & i + j)) = 0) And _
(StrComp(ws1.Range(newLastCmtCol & i + j), ws1.Range(oldLastCmtCol & i + j)) = 0) And _
(StrComp(ws1.Range(newLastNoteCol & i + j), ws1.Range(oldLastNoteCol & i + j)) = 0) And categoryCode = 1 Then
categoryCode = 1
ElseIf IsEmpty(ws1.Range(oldLastCmtTypeCol & i + j)) And IsEmpty(ws1.Range(oldLastCmtCol & i + j)) And IsEmpty(ws1.Range(oldLastNoteCol & i + j)) Then
categoryCode = 3
Exit For
Else
categoryCode = 2
End If
Next j
Any solution?
Your issues seems to be with cells containing an error, not special characters.
If so, you probably want to filter out such cells.
You could use IsError to wrap your code, e.g.
If (Not (IsError(ws1.Range(newLastCmtTypeCol & i + j))) and _
Not (IsError(ws1.Range(oldLastCmtTypeCol & i + j))) and _
... _
) Then
Then you would be able to compare anything else.
You may want to use conversions between String and numbers, if needed.
Public Function DelInvalidCharacters(InputString As String) As String
Dim ModString As String, InvalidChars As String, Char As String
Dim i As Integer
InvalidChars = "\/:*?""<>|';#,()%&$+- "
ModString = vbNullString
For i = 1 To Len(InputString)
Char = Mid(InputString, i, 1)
If InStr(1, InvalidChars, Char) = 0 Then
ModString = ModString & Char
End If
Next i
DelInvalidCharacters = ModString
End Function
Just call this function for each variable you want to strip bad characters out of
Calling it like this
Dim this As String
this = "*this"
this = DelInvalidCharacters(this)
My string is in the format Cells(i, 6) & ("-000") & (q). Here Cells(i,6).value is an integer.
I want to add 1 to q, from the string it is in.
ElseIf k > 0 Then
Sht1.Cells(erow, 3) = CInt(sht3.Cells(i, 5).value) + 1
Sht1.Cells(erow, 4) = CInt(sht3.Cells(i, 6).value) + 1
Sht1.Cells(erow, 1) = Sht1.Cells(erow - 1, 1).value + 1
End If
Try to replace your code with this:
If k > 0 Then
Sht1.Cells(erow, 3) = CInt(sht3.Cells(i, 5).value) + 1
Debug.Print CInt(sht3.Cells(i, 5).value)
Sht1.Cells(erow, 4) = CInt(sht3.Cells(i, 6).value) + 1
Debug.Print CInt(sht3.Cells(i, 6).value)
Sht1.Cells(erow, 1) = Sht1.Cells(erow - 1, 1).value + 1
Debug.Print Sht1.Cells(erow - 1, 1).value
End If
And see where it breaks. Take a look at the immediate window. Probably the value is not a number.
If you edit the code a bit, you may get what you want:
Public Sub TestMe
If k > 0 Then
Sht1.Cells(erow, 3) = IncreaseWithOne(sht3.Cells(i, 5).value)
End If
End Sub
Public Function IncreaseWithOne(strValue As String) As String
Dim myVal As Long
myVal = Split(strValue, "-")(1)
IncreaseWithOne = Split(strValue, "-")(0) & "-" & Format(myVal + 1, "0000")
End Function
But it is really better, if you edit your question to what you want. E.g., you want to split the string 25-00001, cast to integer and increment the second part and return 25-00002. Because adding integer to string is not supported by any programming language.
From your other question (linked at bottom), we know that the digits you want to increment are always the right-hand 4 characters, so you could use Right to isolate the numerical part. I also think you have now taken a different approach and are storing the increment value separately. For reference though, this is how you could have done it:
Dim myString as String
myString = "25-0003"
' Assume there is always a single dash before the number to increment
' This means we can use Split to create two parts, before and after "-"
Dim myVal as Integer
myVal = Val(Split(myString, "-")(1))
' >> myVal = 3
myVal = myVal + 1
' >> myVal = 4
myString = Split(myString,"-")(0) & "-" & Format(myVal, "0000")
' >> myString = "25-0004"
So to edit your actual code, implementing the above code as a function, it becomes
Sub ThisIsYourSub()
If k > 0 Then
Sht1.Cells(erow, 3) = IncrementString( sht3.Cells(i, 5).value )
Sht1.Cells(erow, 4) = IncrementString( sht3.Cells(i, 6).value )
Sht1.Cells(erow, 1) = IncrementString( Sht1.Cells(erow - 1, 1).value)
End If
End Sub
Function IncrementString(ByVal myString as String) as String
' You should have some error handling in here!
Dim myVal as Integer
myVal = Val(Split(myString, "-")(1)) + 1
IncrementString = Split(myString,"-")(0) & "-" & Format(myVal, "0000")
End Function
Split Documentation:
https://msdn.microsoft.com/en-us/library/office/gg278528.aspx
Your other question, including details on using the Format function as above:
Standard pattern of string is like 16-000q. Use leading zeros to create 4 digit string from q
My spreadsheet has a column with value like this string:
some text (text1) some test (text2) (text1)
How do I get all values between parentheses? The result I am looking for is:
text1, text2
Even if text1, text2... testn is present in the cell multiple times, I need it in the result only once.
I found a function GetParen here: Get the value between the brackets
It is helpful, but it gives the fist available value in the parentheses and ignores the rest.
It seems unwieldy to have one User Defined Function for individual entries and another for a collective result of all entries.
Paste the following into a standard module code sheet.
Function getBracketedText(str As String, _
Optional pos As Integer = 0, _
Optional delim As String = ", ", _
Optional dupes As Boolean = False)
Dim tmp As String, txt As String, a As Long, b As Long, p As Long, arr() As Variant
tmp = str
ReDim arr(1 To 1)
For b = 1 To (Len(tmp) - Len(Replace(tmp, Chr(40), vbNullString)))
p = InStr(p + 1, tmp, Chr(40))
txt = Trim(Mid(tmp, p + 1, InStr(p + 1, tmp, Chr(41)) - (p + 1)))
If UBound(Filter(arr, txt, True)) < 0 Or dupes Then '<~~ check for duplicates within the array
a = a + 1
ReDim Preserve arr(1 To a)
arr(UBound(arr)) = txt
End If
Next b
If CBool(pos) Then
getBracketedText = arr(pos)
Else
getBracketedText = Join(arr, delim)
End If
End Function
Use like any other native worksheet function. There are optional parameters to retrieve an individual element or a collection as well as changing the default <comma><space> delimiter.
This code works for me:
Sub takingTheText()
Dim iniP 'first parenthesis
Dim endP 'last parentehis
Dim myText 'the text
Dim txtLen
Dim i
Dim tmp
Dim j
myText = Range("A1").Value
txtLen = Len(myText)
j = 0
Do 'Loop in the text
i = i + 1 'a counter
iniP = InStr(1, myText, "(", 1) 'found the first occurence of the (
endP = InStr(1, myText, ")", 1) 'same as above
tmp = tmp & Right(Left(myText, i), 1) 'take the text garbage text
If i = iniP Then 'here comes the work
j = j + 1 'here take the cell index
myText = Replace(myText, tmp, "") 'remove the garbage text in front the first (
tmp = Left(myText, endP - iniP - 1) 'reuse the var to store the usefull text
Cells(1, 2).Value = Cells(1, 2).Value & Chr(10) & tmp 'store in the cell B1
'If you want to stored in separated cells use the below code
'Cells(j, 2).Value = tmp
myText = Replace(myText, tmp & ")", "", 1, 1) ' remove the garbage text from the main text
tmp = Empty 'empty the var
i = 0 'reset the main counter
End If
Loop While endP <> 0
End Sub
Result:
Please check and tellme if is ok.
Edit#1
Cells(1, 2).Value = Cells(1, 2).Value & Chr(10) & tmp this code store the text in separated lines inside the same cell, may be you want to use spaces between the resulting text because of chr(10) (also you can use chr(13)), then you can use Cells(1, 2).Value = Cells(1, 2).Value & " " & tmp, or use any other character instead the string inside the & symbols
I am working on small project. I have encountered a problem that I am not able to bypass. Any help would be highly appreciated.
I have the following sheets:
Sheet1
Sheet2
I need a function that extracts those 3 figures from Sheet1 (there can be more or less than 3), they are always limited by "()" and look for values in Sheet2 based on figures in column A1.
I was able to write the following code (with help of this question) for extracting figures, but I do not know how to isolate figures from single cell and look based on it in sheet2:
Edit:
I thought I will manage with the rest, but I was wrong. I would appreciate additional help to expand the code to return column B from Sheet2. Generally, logic is that function splits cell from sheet1 and then each item is looked in Sheet2. The final result of this function would be:
Test1
Test2
Test3
I have updated the code with what I tried myself.
Function onlyDigits(s As String) As String
Dim retval As String
Dim i,j As Integer
Dim TestRng as Range
Dim NoArr() as String
Dim TestRes() as String
retval = ""
s = Replace(s, ")", " ")
For i = 1 To Len(s)
If Mid(s, i, 1) >= "0" And Mid(s, i, 1) <= "9" Or Mid(s, i, 1) = " " Then
retval = retval + Mid(s, i, 1)
End If
Next
'deletes last unnecessary space
retval = Left(retval, Len(retval) - 1)
'array with results after extracting numbers
NoArr() = Split(retval, " ", , vbTextCompare)
'vlookedup range
set TestRng = Worksheets("Sheet2").Range("A1:B3")
For j = LBound(NoArr) To UBound(NoArr)
TestRes(j) = Application.WorksheetFunction.VLookup(NoArr(j), TestRng, 2, 0)
Next j
onlyDigits = TestRes
End Function
Keeping with your current method, I modified your function to return the value you need by passing in a place holder. I modified the first and second to last lines.
Function onlyDigits(s As String, pos As Integer) As String
Dim retval As String
Dim i As Integer
retval = ""
s = Replace(s, ")", " ")
For i = 1 To Len(s)
If Mid(s, i, 1) >= "0" And Mid(s, i, 1) <= "9" Or Mid(s, i, 1) = " " Then
retval = retval + Mid(s, i, 1)
End If
Next
'deletes last unnecessary space
retval = Left(retval, Len(retval) - 1)
onlyDigits = Split(retval, " ", , vbTextCompare)(pos)
End Function
To call in cell write: =onlyDigits(A1,0) the zero is the position to return
Example
Column E shows the equation used in column D
ok I solved my problem with following code:
F Function onlyDigits(s As String) As String
Dim retval As String
Dim i, j As Integer
Dim TestRng As Range
Dim NoArr() As String
Dim TestRes() As String
retval = ""
s = Replace(s, ")", " ")
For i = 1 To Len(s)
If Mid(s, i, 1) >= "0" And Mid(s, i, 1) <= "9" Or Mid(s, i, 1) = " " Then
retval = retval + Mid(s, i, 1)
End If
Next
'deletes last unnecessary space
retval = Left(retval, Len(retval) - 1)
'array with results after extracting numbers
NoArr() = Split(retval, " ", , vbTextCompare)
'vlookedup range
Set TestRng = Worksheets("Sheet2").Range("A1:B3")
For j = LBound(NoArr) To UBound(NoArr)
ReDim Preserve TestRes(j)
TestRes(j) = Application.WorksheetFunction.VLookup(CLng(NoArr(j)), TestRng, 2, False)
Next j
onlyDigits = Join(TestRes, vbNewLine)
End Function
I am searching for a solution to convert a double to a string, but the string should have a comma before the decimal place, not a point.
"One and a half" should look that way 1,5 (german notation).
Thanks for your help!!
A combination of CStr and Replace will do the job.
Function Dbl2Str(dbl As Double) As String
Dbl2Str = Replace(CStr(dbl), ".", ",")
End Function
Unfortunately in VBA, you can't easily write locale-independent code. That is, you can't specify a locale when you take a CStr cast.
One work around is to convert a double like 0.5 to a string and see what you end up with. If you end up with 0,5 then you're in German (etc.) locale, and you don't need to do anything else.
If you end up with 0.5 then you know you need to make a conversion. Then you just need to traverse your string, replacing dots with commas and vice versa (the vice versa bit is important in case your string has thousands delimiters). You can use Replace for that.
Following RubberDuck comment I ended up with this:
Function DblToStr(x As Double)
DblToStr = CStr(x)
If (Application.ThousandsSeparator = ".") Then
DblToStr = Replace(DblToStr, ".", "")
End If
If (Application.DecimalSeparator = ".") Then
DblToStr = Replace(DblToStr, ".", ",")
End If
End Function
something like this then
Dim somestring As String
Dim someDec As Double
someDec = 1.5
somestring = CStr(someDec)
somestring = Replace(somestring, ".", ",")
MsgBox (somestring)
Select the cells you wish to convert and run this small macro:
Sub changeIT()
For Each r In Selection
t = r.Text
If InStr(1, r, ".") > 0 Then
r.Clear
r.NumberFormat = "#"
r.Value = Replace(t, ".", ",")
End If
Next r
End Sub
Only those cells with "." in them will change and they will be Strings rather than Doubles
I checked the other answers but ended up writing my own solution to convert user inputs like 1500.5 into 1,500.50, using below code:
'
' Separates real-numbers by "," and adds "." before decimals
'
Function FormatNumber(ByVal v As Double) As String
Dim s$, pos&
Dim r$, i&
' Find decimal point
s = CStr(v)
pos = InStrRev(s, ".")
If pos <= 0 Then
pos = InStrRev(s, ",")
If pos > 0 Then
Mid$(s, pos, 1) = "."
Else
pos = Len(s) + 1
End If
End If
' Separate numbers into "r"
On Error Resume Next
i = pos - 3
r = Mid$(s, i, 3)
For i = i - 3 To 1 Step -3
r = Mid$(s, i, 3) & "," & r
Next i
If i < 1 Then
r = Mid$(s, 1, 2 + i) & "," & r
End If
' Store dot and decimal numbers into "s"
s = Mid$(s, pos)
i = Len(s)
If i = 2 Then
s = s & "0"
ElseIf i <= 0 Then
s = ".00"
End If
' Append decimals and return
FormatNumber = r & s
End Function