Find Length and Format and Compare

[HelperBee]

I need to search all the cells in a worksheet for values longer than 30
characters and shade those cells yellow.
For each of the yellow cells I need to compare the contents to see if they
contain words to be abbreviated. I have a two column worksheet where one
column has the search words and the other has the abbreviations.
I need to read each of the over 30 cells that were shaded and replace each
word in the abbreviation list with the abbreviated version.

Note: multiple words within a cell could need abbreviation, e.g. Insurance
Payment Invoice could be in the cell and get abbreviated to Insur Pymt Inv,
only one word and abbreviation per cell in my abbreviation file.

Thoughts?

I've used the conditional formatting in 2007 which works great for finding
the 30 characters and shading them, but when it comes to the abbreviations
I've been stuck with manual comparison.

Help appreciated, dozens of files to apply this to.

Thanks.

 

[Matthew Herbert]

HelperBee,

Here is some code that should at least give you an idea of how this can
work. The code runs on a selection of cells. Since you didn't provide
example data, I made some assumptions. (For example, I don't know what you
mean by "one word and abbreviation per cell").

Best,

Matthew Herbert

Sub FindLengthAndReplace()
Dim Rng As Range
Dim rngCell As Range

Set Rng = Selection

'loop each cell in the Selection
For Each rngCell In Rng.Cells
With rngCell
'If the character length of the value within the cell
' is greater than or equal to 30, then color the
' cell and perform the desired replacements specified
' below. (If no replacements are found, nothing
' happens).
If Len(.Value) >= 30 Then
.Interior.ColorIndex = 16 'use a desired number here
.Value = Replace(.Value, "Insurance", "Insur")
.Value = Replace(.Value, "Payment", "Pymt")
.Value = Replace(.Value, "Invoice", "Inv")
End If
End With
Next rngCell
End Sub

 

[JLGWhiz]

What you describe would require a very complex code to locate words of 30 or
more characters in cells containing multiple words. Almost the same thing
can be accomplished with the code below. I say almost because your list of
words and their standard abbreviations might not include all words that
exceed 30 characters in lenghth. But it will replace all the occurrences of
word that are in your list, provided the list of whole words are in a single
column and the abbreviations are in a single column and they are in the same
order. The code below uses an arbitrary range of A1:H30 which you can
change to the actual range to search. I chose Column Y for the whole words
and Column Z for the abbreviations and only use a limited number of words
for testing. I made the comparison case insensitive so you do not have to
worry about words being missed beacuse of capitalization, etc. There is a
way to include misspelled words but it is more trouble than it is worth, so
I avoided it for this exercise. This code goes in the public module1.

Sub abbrev()
Dim rng1 As Range, rng2 As Range, sh As Worksheet
Set sh = ActiveSheet
Set rng1 = sh.Range("Y2:Y7") '<<Change to actual
Set rng2 = sh.Range("Z2:Z7") '<<Change to actual
For i = 2 To rng1.Rows.Count + 1

'<<Change search range to actual. Change Col ref Y and Z. below

sh.Range("A1:M30").Replace What:=sh.Range("Y" & i).Value, _
Replacement:=sh.Range("Z" & i).Value, MatchCase:=False
Next
End Sub

 

[Javed]

HelperBee,

Here is some code that should at least give you an idea of how this can
work.  The code runs on a selection of cells.  Since you didn't provide
example data, I made some assumptions.  (For example, I don't know whatyou
mean by "one word and abbreviation per cell").

Best,

Matthew Herbert

Sub FindLengthAndReplace()
Dim Rng As Range
Dim rngCell As Range

Set Rng = Selection

'loop each cell in the Selection
For Each rngCell In Rng.Cells
    With rngCell
        'If the character length of the value within the cell
        '   is greater than or equal to 30, then color the
        '   cell and perform the desired replacements specified
        '   below.  (If no replacements are found, nothing
        '   happens).
        If Len(.Value) >= 30 Then
            .Interior.ColorIndex = 16 'use a desired numberhere
            .Value = Replace(.Value, "Insurance", "Insur")
            .Value = Replace(.Value, "Payment", "Pymt")
            .Value = Replace(.Value, "Invoice", "Inv")
        End If
    End With
Next rngCell
End Sub








- Show quoted text -

Have you tried with autocorrect feature for replacement of text.

You can use
Application.Autocorrect.AddReplacement What As String, Replacement As
String
for adding your replacement table.

 

[HelperBee]

This looks like what I need, except I would need to alter it as the
abbreviations are in a separate workbook from those workbooks I am updating.
How can I modify this to reflect finding all cells in the selected range in
the active workbook that are over 30 characters in length then performing
your suggested function but changing it so that it references the
abbreviations from a separate workbook in a separate directory where the
abbreviations are on a sheet named "Abbrev List".

Thanks.

 

[HelperBee]

I think the solution would be a combination of your post and the one from
JLGWhiz.

Your post has the length and format info, and his has the abbreviation
needs, minus what I need to compare against an outside workbook.

 

[HelperBee]

I need to compare against an outside workbook full of hundreds of
abbreviations. How could your code be modified to do that? See my needs in
response to JLGWhiz.

Thanks !