How to truncate less than 30 characters and delete in Excel VBA? - excel

I have an excel sheet with some rows of descriptions in a single column, what I am aiming is to get a formula that would truncate it upto certain character limit for example 30 characters and if the truncation stops at 30 character in the middle of the word then I remove that last word.
Here is the Formula that i am trying to make it work.
=LEFT(A1,FIND(" ",A1,30)-1)

Use AGGREGATE to locate the last space within the first 31 characters.
=LEFT(A2, AGGREGATE(14, 7, ROW($1:$31)/(MID(A2&" ", ROW($1:$31), 1)=" "), 1) -1)

A none loop method
=IF(LEN(A2)<30,A2,LEFT(A2,FIND("}}}",SUBSTITUTE(A2," ","}}}",30-LEN(SUBSTITUTE(LEFT(A2,30)," ",""))))-1))

Try something like this:
Put in a module at VBA Editor (ALT+F11) -> Insert New Module.
When you past this code you can call it from any cell with "=NotTruncateWord(A1;30)"
There is some ajustments to do, because it is hard to know what is a Word (something after a space?), I ask because if someone write a 35 characteres string with no space, I will consider a word and remove all?
Public Function NotTruncateWord(Value, Limit)
LastSpaceBeforeLimit = 0
FirstSpaceAfterLimit = 9999
Phrase_Lenght = Len(Value)
If Phrase_Lenght > Limit Then
For i = 1 To Phrase_Lenght
check = Mid(Value, i, 1)
If Asc(check) = 32 Then
If i < Limit Then
LastSpaceBeforeLimit = i
ElseIf i < FirstSpaceAfterLimit Then
FirstSpaceAfterLimit = i
End If
End If
Next
If LastSpaceBeforeLimit > 0 Then
NotTruncateWord = Left(Value, LastSpaceBeforeLimit)
Else
NotTruncateWord = Left(Value, Limit)
End If
Else
'no need to truncate
NotTruncateWord = Value
End If
End Function

Related

How to split a number into individual digits VB using substring

I tried to put seconds in 2 text-boxes, each digit in one. Example x= 56 x1= 5 and x2= 6
' s = TimeOfDay.Second
TextBox15.Text = s.Substring(0, 1)
TextBox16.Text = s.Substring(1, 1)'
When I try this I get the following error: System.ArgumentOutOfRangeException
Any ideas on how to fix this?
ArgumentOutOfRange exceptions occurs whenever you attempt to get a character that doesn't exist at the given position. So what is happening is that there is either not a String at position 0 with a length of 1 or there is not a String at position 1 with a length of 1.
To prevent this, add a simple If/Then statement to check if the length of the original String at least equal to the position of the character. Also for what it's worth, since you only want one letter, simply get the character at the desired index of the String.
Here is a quick example:
If s.Length >= 1 Then
TextBox15.Text = s(0).ToString()
End If
If s.Length >= 2 Then
TextBox16.Text = s(1).ToString()
End If
Fiddle: Live Demo
You don't need to convert it to a string before getting the digits, just doing the maths to get them will work well enough:
Dim rightNow = DateTime.Now
TextBox15.Text = (rightNow.Second \ 10).ToString()
TextBox16.Text = (rightNow.Second Mod 10).ToString()
And another approach.
Dim c() As Char = DateTime.Now.Second.ToString("00").ToArray
TextBox1.Text = c(0)
TextBox2.Text = c(1)

Excel How to stop LEFT formula after meeting first Alpha in string

So i am trying to extract just a specific part of text strings (part numbers) for a vlookup,
I have got a formula that gives me the part number I want for most cases, which stops the LEFT formula after it reaches the last number in the text string. Some of the part numbers have more numbers further in the text string.
I need the formula to return the text string until the last number but to stop once it changes back to Alpha again.
I hope this makes sense I have attached a screenshot to example the issue and my code. If you look in column R and see the FR70YERXX/3, that should stop before the Y but i simply can't get my head round this one.
=LEFT(J2,MAX(IFERROR(FIND({1,2,3,4,5,6,7,8,9,0},J2,ROW(INDIRECT("1:"&LEN(J2)))),0)))
Put the following code into a module in Excel
Function LeftCode(s As String) As String
i = 1
While Not ((Mid(s, i, 1) >= "0") And (Mid(s, i, 1) <= "9")) And (i <= Len(s))
i = i + 1
Wend
If i > Len(s) Then
LeftCode = s
Else
While Not ((Mid(s, i, 1) < "0") Or (Mid(s, i, 1) > "9")) And (i <= Len(s))
i = i + 1
Wend
If i > Len(s) Then
LeftCode = s
Else
LeftCode = Left(s, i - 1)
End If
End If
End Function
Then in column R type:
=LeftCode(J2)
and copy this down
Explanation
Create a function to take a string and return a string
Function LeftCode(s As String) As String
Starting at the first character, loop through the string one character at a time until you find a digit (0-9)
i = 1
While Not ((Mid(s, i, 1) >= "0") And (Mid(s, i, 1) <= "9")) And (i <= Len(s))
i = i + 1
Wend
If we have reached the end, with no numbers, then return it all
If i > Len(s) Then
LeftCode = s
Otherwise continue to loop through each character until we find a non digit
Else
While Not ((Mid(s, i, 1) < "0") Or (Mid(s, i, 1) > "9")) And (i <= Len(s))
i = i + 1
Wend
If we reach the end then we want the whole thing
If i > Len(s) Then
LeftCode = s
Else
Otherwise we want up to the last but one character
LeftCode = Left(s, i - 1)
End If
End If
End Function
It seems you want to to truncate until the first combination of digit is followed by non-digit. If so try this:
=LEFT(H2,AGGREGATE(15,6,ROW($1:$98)
/ISNUMBER(VALUE(MID(H2,ROW($1:$98),1)))
/ISERROR(VALUE(MID(H2,ROW($2:$99),1))),1))
Solution 1
Well I can give a long ugly looking formula if you are willing to use. Try this
=-LOOKUP(1,-LEFT(MID(A1,MIN(SEARCH({0,1,2,3,4,5,6,7,8,9},A1&"0123456789")),LEN(A1)-MIN(SEARCH({0,1,2,3,4,5,6,7,8,9},A1&"0123456789"))+1),ROW(INDIRECT("1:"&LEN(MID(A1,MIN(SEARCH({0,1,2,3,4,5,6,7,8,9},A1&"0123456789")),LEN(A1)-MIN(SEARCH({0,1,2,3,4,5,6,7,8,9},A1&"0123456789"))+1))))))
See image for reference.
Solution 2
Using helper column
In Cell B2 enter the following formula to get the position of first number
=MIN(SEARCH({0,1,2,3,4,5,6,7,8,9},A2&"0123456789"))
Then in Cell C2 to get the string after removing alphabets preceding first number, enter
=RIGHT(A2,LEN(A2)-B2+1)
Finally, in Cell D2 enter the below formula
=IFERROR(-LOOKUP(1,-LEFT(C2,ROW(INDIRECT("1:"&LEN(C2))))),"")
Drag/Copy down as required. See image for reference.

Selecting Characters In String

I can grab every 2 chars from sum2.text in order (102030) i get 10,20,30
but my issue is, selecting exactly those numbers 10,20,30 in order
my current code below outputs: msgbox(10) msgbox(20) msgbox(30) but wont select and replace those exact numbers in order one by one
My code:
For i = 0 To sum2.Text.Length - 1 Step 2 'grabs every 2 chars
Dim result = (sum2.Text.Substring(i, 2)) 'this holds the 2 chars
MsgBox(result) 'this shows the 2 chars
sum2.SelectionStart = i 'this starts the selection at i
sum2.SelectionLength = 2 'this sets the length of selection (i)
If sum2.SelectedText.Contains("10") Then
sum2.SelectedText = sum2.SelectedText.Replace("10", "a")
End If
If sum2.SelectedText.Contains("20") Then
sum2.SelectedText = sum2.SelectedText.Replace("20", "b")
End If
If sum2.SelectedText.Contains("30") Then
sum2.SelectedText = sum2.SelectedText.Replace("30", "c")
End If
my probolem is that it will show the numbers in sum2 one by one correctly, but it would select and replace at all or one by one. I believe the issue is with the selection length
OK, here's my attempt from what I'm understanding you are wanting to do. The problem is, you are trying to alter the string that the loop is using when you replace "10" with "a" so you need to create a variable to hold your newly built string.
Dim part As String = ""
Dim fixed As String = ""
For i = 0 To Sum2.SelectedText.Length - 1 Step 2
part = Sum2.SelectedText.Substring(i, 2)
Select Case part
Case "10"
part = part.Replace("10", "a")
Case "20"
part = part.Replace("20", "b")
Case "30"
part = part.Replace("30", "c")
End Select
fixed &= part
Next
Sum2.SelectedText = fixed
Of course, this is only to show the workings of moving through the string and changing it. You would need to replace your selected text with the newly formatted result (fixed in this case)
Result: ab3077328732
Also, just so you know, if this format was such that no 2 digits would interfere, you could simply do a
sub2.selectedtext.replace("10", "a").Replace("20", "b").Replace...
However if you had 2 digits like 11 next to 05 it would fail to give desired results because if would change 1105 to 1a5. Just something to think about.
Here's some code to get you started:
For i = 0 To sum2.SelectedText.Length - 1 Step 2
MessageBox.Show(sum2.SelectedText.Substring(i, 2))
Next

VBA Greater Than Function Not Working

I have an issue where I am trying to compare a values that can be alphanumeric, only numeric, or only alphabetic.
The code originally worked fine for comparing anything within the same 100s group (IE 1-99 with alphabetic components). However when I included 100+ into it, it malfunctioned.
The current part of the code reads:
For j = 1 To thislength
If lennew < j Then
enteredval = Left("100A", lennew)
ElseIf lennew >= j Then
enteredval = Left("100A", j)
End If
If lenold < j Then
cellval = Left("67", lenold)
ElseIf lenold >= j Then
cellval = Left("67", j)
End If
'issue occurs here
If enteredval >= cellval Then
newrow = newrow+1
End If
Next j
The issue occurs in the last if statement.
When cycling through the 100 is greater than the 67 but still skips over. I tried to declare them both as strings (above this part of code) to see if that would help but it didn't.
What I am trying to accomplish is to sort through a bunch of rows and find where it should go. IE the 100A should go between 100 and 100B.
Sorry lennew=len("100A") and lennold=len("67"). And thislength=4or whatever is larger of the two lengths.
The problem is that you're trying to solve the comparison problem by attacking specific values, and that's going to be a problem to maintain. I'd make the problem more generic by creating a function that supplies takes two values returns -1 if the first operand is "before" the second, 0 if they are the same, and 1 if the first operand is "after" the second per your rules.
You could then restructure your code to eliminate the specific hardcoded prefix testing and then just call the comparison function directly, eg (and this is COMPLETELY untested, off-the-cuff, and my VBA is VERRRRRY stale :) but the idea is there: (it also assumes the existence of a simple string function called StripPrefix that just takes a string and strips off any leading digits, which I suspect you can spin up fairly readily yourself)
Function CompareCell(Cell1 as String, Cell2 as String) as Integer
Dim result as integer
Dim suffix1 as string
Dim suffix2 as string
if val(cell1)< val(cell2) Then
result = -1
else if val(cell1)>val(cell2) then
result = 1
else if val(cell1)=val(cell2) then
if len(cell1)=len(cell2) then
result =0
else
' write code to strip leading numeric prefixes
' You must supply StripPrefix, but it's pretty simple
' I just omitted it here for clarity
suffix1=StripPrefix(cell1) ' eg returns "ABC" for "1000ABC"
suffix2=StripPrefix(cell2)
if suffix1 < suffix2 then
result = -1
else if suffix1 > suffix2 then
result = 1
else
result = 0
end if
end if
return result
end function
A function like this then allows you to take any two cell references and compare them directly to make whatever decision you need:
if CompareCell(enteredval,newval)>=0 then
newrow=newrow+1
end if

How can I divide a number string by 1000 without converting to number?

I am trying to make a certain string with Digits change form, so that it looks like below.
Modified to show with Digits instead of X.
So let´s set, i get a number, like this.
234.123123123
I need to change how it appears, for 3 digits before a Dot, it would need to become.
0.234123123123
And let´s say it´s 2.23123123123, that would become, 0.0023123123123
Now i will try to explain the Formula, bare with my English.
The formula needs to change the position of the Dot ".".
You can see that it changes place, But you can also see that i am adding 0s.
That is important, the 0s needs to be added IF the dot get´s to the far left (the beginning of the string).
So how much must the Dot move?
The Dot must Always move 3 steps to the left.
And if it hit´s the wall (the start of the string) you need to add 0s, and then one 0s before the dot.
So if the number is, 2.222222
I will first have to move the dot to the left, let´s show step by step.
Step 1:
.2222222
Step 2:
.02222222
Step 3:
0.02222222
It must Always be a 0 Before the Dot, it it ever hit the Start.
It sounds more complicated then it is, it´s just that i don't know how to explain it.
EDIT:
My attempt:
TextPos = InStr(1, TextBox4.Value, ".") - 2
If (TextPos = 4) Then
sLeft = Left(TextBox4.Value, Len(TextBox4.Value) - Len(TextBox4.Value) + 2)
sRight = Right(TextBox4.Value, Len(TextBox4.Value) - 2)
sFinal = (sLeft & "." & Replace(sRight, ".", ""))
TextBox4.Value = Replace(sFinal, "-", "")
End If
If (TextPos = 3) Then
TextBox4.Value = "0." + Replace(TextBox4.Value, ".", "")
End If
If (TextPos = 2) Then
TextBox4.Value = "0.0" + Replace(TextBox4.Value, ".", "")
End If
If (TextPos = 1) Then
TextBox4.Value = "0.00" + Replace(TextBox4.Value, ".", "")
End If
TextBox4.Value = Replace(TextBox4.Value, "-", "")
If i /1000 it, may work, but it seems like it will alter the number, leaving it to fail.
Original: 25.1521584671082
/1000 : 2.51521584671082E-02
As you can see, it doesn't work as expected.
It should become 0.0251521584671082E-02 (And of course i don't want " E- " to be there.
So if it's possible to do this, but ONLY moving and not actually, dividing (i think excel is limited to how many numbers it can calculate with) then it will work.
Worth Noting, the numbers shown are actually less (shorter) then the real number for some reason, if i write it down to a text file, it becomes this:
2.51521584671082E-02251521584671082E-02
So as you can see, i probably hit a Wall in the calculation, so it changes to Characters (I know math uses those, but no idea what they mean, and they are useless for me anyway).
And i think it's because of them that it fails, not sure though.
EDIT:
Okay, by limiting to 15 decimals it will return the correct place, but i would like not to do this round about, should Excel really be limited to only 15 Decimals, or is it "Double,Float etc" that does this?
EDIT 2:
Tony's example provides this:
Original: 177.582010543847177582010543847
Tony's: 0.1775820110177582011
Round(15decimals): 0.1775820105438470177582010543847
Not really sure, but isn't it Incorrect, or perhaps i did something wrong?
If possible, i want ALL decimals and number to stay in place, as everything is already correct, it's just that they are in the wrong place.
/1000 solves this, but not in the best way, as it will recalculate instead of just moving.
Normally i wouldn't care, the results are the same, but here it does matter as you can see.
I can however think of a solution, where i till look for the position of the Dot, then cut out the last decimals, divide the Result by 1000, then later add the last decimals, though that is more of a hack , not sure if it will actually work.
I conclude that this is Answered, it does what i want, and the limitations is in the Calculation itself, not the Solution.
All Solutions work pretty much in the same way, but i chose Tony's as he was first to comment the solution in my question.
Many Thanks everyone!
It appears to me through all your edits that you want to divide the number by one thousand. To do this, you can simply use
TextBox4.Value = TextBox4.Value / 1000
You code sometimes fails because it does not handle every situation. You calculate TextPos so:
TextPos = InStr(1, TextBox4.Value, ".") - 2
You then handle TextPos being 4, 3, 2 or 1. But if, for example, TextBox4.Value = "2.22222" then TextPos = 0 and you have no code for that situation.
At 11:45 GMT, I suggested in a comment that dividing by 1000 would give you the result you seek. At 14:08 GMT, tunderblaster posted this as an answer. It is now 15:23 but you have not responded to either of us.
Having tried your code, I now know these answer do not match the result it gives when it works because you remove the sign. The following would give you almost the same as a working version of your code:
TextBox4.Value = Format(Abs(Val(TextBox4.Value)) / 1000, "#,##0.#########")
The only deficiency with this statement is that it does not preserve all the trailing decimal digits. Is this really important?
While I was preparing and posting this answer, you edited your question to state that dividing by 1000 would sometimes give the result in scientific format. My solution avoids that problem.
If you want to avoid floating point error when dividing by 10, you may use the Decimal type
Private Sub CommandButton1_Click()
Dim d As Variant
d = CDec(TextBox1.Text)
TextBox1.Text = d / 1000
End Sub
Is this what you are trying?
Sub Sample()
Dim sNum As String, SFinal As String
Dim sPref As String, sSuff As String
Dim nlen As Long
sNum = "234.123123123123123123131231231231223123123"
SFinal = sNum
If InStr(1, sNum, ".") Then
sPref = Trim(Split(sNum, ".")(0))
sSuff = Trim(Split(sNum, ".")(1))
nlen = Len(sPref)
Select Case nlen
Case 1: SFinal = ".00" & Val(sPref) & sSuff
Case 2: SFinal = ".0" & Val(sPref) & sSuff
Case 3: SFinal = "." & Val(sPref) & sSuff
End Select
End If
Debug.Print SFinal
End Sub
Try this. It works by initialy padding the string with leading 0's, shifting the DP, then removing any unnecassary remaining leading 0's
Function ShiftDecimalInString(str As String, Places As Long) As String
Dim i As Long
If Places > 0 Then
' Move DP to left
' Pad with leading 0's
str = Replace$(Space$(Places), " ", "0") & str
' Position of .
i = InStr(str, ".")
str = Replace$(str, ".", "")
If i > 0 Then
' Shift . to left
str = Left$(str, i - Places - 1) & "." & Mid$(str, i - Places)
' strip unnecassary leading 0's
Do While Left$(str, 2) = "00"
str = Mid$(str, 2)
Loop
If str Like "0[!.]*" Then
str = Mid$(str, 2)
End If
ShiftDecimalInString = str
Else
' No . in str
ShiftDecimalInString = str
End If
ElseIf Places < 0 Then
' ToDo: Handle moving DP to right
Else
' shift DP 0 places
ShiftDecimalInString = str
End If
End Function
This "answer" responses to the issue that you want as much precision in the result as possible.
When I was at school this was called spurious accuracy. I have forgotten most of my mathematics in this area but I will try to give you an understanding of the issue.
I have a value, 2.46, which is accurate to 2 decimal places. That is the true value is somewhere in the range 2.455 to 2.465.
If I feed these values into a square root function I will get:
sqrt(2.455) = 1.566843961599240
sqrt(2.46) = 1.568438714135810
sqrt(2.465) = 1.570031846810760
From this I see the square root of the true value is somewhere between 1.567 and 1.570; any extra decimal digits are spurious.
If I understand correctly, you wish to use these numbers to make adjustments. Are you capable of making adjustments to 15 decimal digits?
If you remember your calculus you can look up "propogation of error" for a better explanation.

Resources