CODEWITHSUNDEEP
stringexcelreplacestring-lengthvba
Scott
Scott

Reputation: 79

Delete all text to right of variable character position based on variable string length

Problem: I have a column where each cell has varying lengths and varying sentence structure. If any cell exceeds 1000 characters in length, find the first occurrence of either a [period], [comma], [semi-colon], [colon] to the right of the 998th character in the string and replace that character with [3 periods](application alternative to an ellipsis). Finally truncate all remaining text after the 3 periods.

Example-

Current Data: [[900 previous characters]]. Visual Basic for Applications enables building user-defined functions (UDFs), automating processes and accessing Windows API and other low-level functionality through dynamic-link libraries (DLLs).

Expected Output: [[900 previous characters]]. Visual Basic for Applications enables building user-defined functions (UDFs)...

In 'Current Data', the length = 1098 characters. The 998th character is the second 's' in "procesS". The first occurrence of one of the desired punctuation marks to the right is the [comma] after (UDFs). That is replaced with [3 periods] and the rest of the string is removed.

Currently this is what I have. I have not figured out how to include the various conditions to find or how to truncate text after the 3 periods. Also, there might be a cleaner way to do all this.

For i = 2 To LR


If Len(Cells(i, 2).Value) > 1000 Then

    Cells(i, 2).Value = Left(Cells(i, 2), 998)
    Cells(i, 2).Value = StrReverse(Replace(StrReverse(Cells(i, 2).Value), StrReverse("."), StrReverse("..."), Count:=1))


End If
Next i

Hopefully I've provided plenty of information about what I am attempting.

Upvotes: 2

Views: 787

Answers (3)

user4039065
user4039065

Reputation:

The position of the last eligible punctuation within the left-most 1000 characters can be located with InStrRev.

dim str as string, p as long
for i=2 to lr
    str = cells(i, "B").value2
    if len(str) > 1000 then
        p = application.max(instrrev(str, chr(44), 998), _
                            instrrev(str, chr(46), 998), _
                            instrrev(str, chr(58), 998), _
                            instrrev(str, chr(59), 998))
        cells(i, "B") = left(str, p-1) & string(3, chr(46))
    end if
next i

Upvotes: 2

L42
L42

Reputation: 19737

Try this to check first occurrence of any punctuation . , ; : after 998 characters.

Dim teststring As String, firstcut As String, extension As String

teststring = String$(1000, "a") & _
    "Lorem ipsum dolor sit amet, consectetur adipiscing elit. " & _
    "In malesuada non enim nec posuere. Praesent placerat nulla enim, " & _
    "at porta justo pharetra ac."

If Len(teststring) > 999 Then
    firstcut = Left$(teststring, 998)

    extension = Right(teststring, Len(teststring) - 998)
    extension = Replace(Replace(Replace(extension, ",", "."), ";", "."), ":", ".")
    extension = Left$(extension, InStr(1, extension, ".") - 1) & "..."

    Debug.Print extension
End If

Upvotes: 2

YasserKhalil
YasserKhalil

Reputation: 9568

Try this demo (may help you)

Sub Demo()
Dim s As String
Dim p As Integer

s = "ab:cde,fghij Hello world, thanks a lot , for everything and "

p = InStr(10, s, ",")
Debug.Print p

s = Mid(s, 1, p - 1) & "..."
Debug.Print s
End Sub

Another demo if you will deal with more options (comma / period / semicolon)

Sub Demo2()
Dim a As Variant
Dim s As String
Dim p As Integer
Dim p1 As Integer
Dim p2 As Integer
Dim p3 As Integer

s = "ab:cde,fghij Hello ; world, thanks. a lot , for everything and "

p1 = InStr(10, s, ",")
p2 = InStr(10, s, ";")
p3 = InStr(10, s, ".")

a = Array(p1, p2, p3)
p = Evaluate("MIN(IF({" & Join(a, ";") & "}>0,{" & Join(a, ";") & "}))")
Debug.Print p

s = Mid(s, 1, p - 1) & "..."
Debug.Print s
End Sub

Upvotes: 1

Related Questions