0
votes

I want to trim a string in MS Excel each cell to 100 characters in a column with 500 cells.

Starting with first cell, check if string length is or equal 100 characters. If the words are more than 100, then remove 1 word in the cell, then check again, if it's more than 100 remove another word until the string is less to 100. Then paste the less than 100 character string into the same cell replacing previous more than 100 character string.

Then move to another cell and replete the previous step.

The words to be removed are in an array

Here is my code so far

Sub RemoveWords()
Dim i As Long
Dim cellValue As String
Dim stringLenth As Long
Dim myString As String
Dim words() As Variant
words = Array("Many", "specific ", "Huawei", "tend", "Motorolla", "Apple")

myString = "Biggest problem with many phone reviews from non-tech specific publications is that its reviewers tend to judge the phones in a vacuum"
For i = 1 To 13
cellValue = Cells(i, 4).Value
        If Not IsEmpty(cellValue) Then
            stringLength = Len(cellValue)
            ' test if string is less than 100
            If stringLength > 100 Then
                Call replaceWords(cellValue, stringLength, words)
            Else
               ' MsgBox "less than 100 "
            End If
        End If          
    Next i

End Sub

Public Sub replaceWords(cellValue, stringLength, words)
    Dim wordToRemove As Variant
    Dim i As Long
    Dim endString As String
    Dim cellPosition As Variant

    i = 0

    If stringLength > 100 Then

        For Each wordToRemove In words
            If InStr(1, UCase(cellValue), UCase(wordToRemove )) = 1 Then
            MsgBox "worked word found" & " -- " & cellValue & " -- " & key
            Else
            Debug.Print "Nothing worked" & " -- " & cellValue & " -- " & key

            End If
        Next wordToRemove 
     Else
     MsgBox "less than 100 "
    End If

End Sub
1
just an another approach, if you like it... I have a code which separates a string into words,(delimiting with ' ', space character) and returns a array of the separated words, now if string length is more then 100 we can make an arrays of all the words out of it and then you can keep concatenating them while maintaining a count of the length.. - Abhinav Rawat
You seem to have forgotten to ask a question! - SJR
I am not sure if it makes a difference for you, but it's Motorola, not Motorolla - Moacir
Do you want to trim all cells down to 100 characters, or 100 words? If words what happends if you have a string with 200 words and none of the words to remove are found in the last 100 - you still want to trim it? And what is the actual question? - paul bica
@paul bica , I want to trim every cell to have 100 characters only, ofcourse words made of only 100 or less characters - Kamotho

1 Answers

0
votes
Sub NonKeyWords()
' remove non key words
'

Dim i As Long
Dim cellValue As String
Dim stringLenth As Long
Dim wordToRemove  As Variant
Dim words() As Variant
Dim item As Variant

' assign non-key words to array
words = words = Array("Many", "specific ", "Huawei", "tend", "Motorolla", "Apple")

' loop though all cells in column D
For i = 2 To 2000
cellValue = Cells(i, 4).Value
    If Not IsEmpty(cellValue) Then
        ' test if string is less than 100
        If Len(cellValue) > 100 Then
        'Debug.Print "BEFORE REMOVING: " & cellValue
            Call replaceWords(cellValue, words, i)
        Else
           ' MsgBox "less than 100"
        End If
    End If
Next i

End Sub

Public Sub replaceWords(cellValue, words, i)

If Len(cellValue) > 100 Then

        For Each wordsToDelete In words
           If Len(cellValue) > 100 Then
            cellValue = Replace(cellValue, wordsToDelete, "")
            'Debug.Print cellValue
            Debug.Print "String length after removal = " & Len(cellValue)
            Debug.Print "remove another word................"
            'cells(i, 4).ClearContents
            Cells(i, 4).Value = cellValue
            Else
            'exit
            End If
        Next
 Else
    Debug.Print "SAVE: " & cellValue

End If

End Sub