VBA Question - Remove keywords from cell text

[Guest]

I have a need to reduce the amount of text in a range of cells. There are
certain keywords that are not necessay in the cells that if removed the text
length would be acceptable.

How do I go about removing keywords from cell text with VBA? This would
need to run in column G of my worksheet.

Here is an example: (keywords are "Q Line" & "120 VAC")

Before:
Q Line THQB 120 VAC 1 pole 20A

After:
THQB 1 pole 20A

Thanks in advance!

 

[Chip Pearson]

Use code like the following:

Option Explicit
Option Compare Text

Sub AAA()
Dim Keywords As Variant
Dim Rng As Range
Dim Ndx As Long
Keywords = Array("Q Line", "120 VAC") ' add more keywords
here
For Each Rng In Selection.Cells
For Ndx = LBound(Keywords) To UBound(Keywords)
Rng.Value = Replace(Rng.Text, Keywords(Ndx), "")
Next Ndx
Next Rng
End Sub



--
Cordially,
Chip Pearson
Microsoft MVP - Excel
Pearson Software Consulting, LLC
www.cpearson.com


message
news:[email protected]...

 

[Chip Pearson]

I should have added that you'll need to select the cells to be
changed prior to running the code.


--
Cordially,
Chip Pearson
Microsoft MVP - Excel
Pearson Software Consulting, LLC
www.cpearson.com

 

[Dave Peterson]

What version of excel are you using?

If you're using xl2k or higher:

Option Explicit
Sub testme2k()

Dim myKeyWords As Variant
Dim myRng As Range
Dim myCell As Range
Dim iCtr As Long

myKeyWords = Array("Q Line", "120 VAC")

With ActiveSheet
Set myRng = Selection
For Each myCell In myRng.Cells
For iCtr = LBound(myKeyWords) To UBound(myKeyWords)
myCell.Value = Replace(expression:=myCell.Value, _
Find:=UCase(myKeyWords(iCtr)), _
Replace:=" ", _
Start:=1, _
Count:=-1, _
compare:=vbTextCompare)
Next iCtr
myCell.Value = Application.Trim(myCell.Value)
Next myCell
End With
End Sub

Replace was added in xl2k. And that has an option to string comparisons and
ignore the case.

For xl97, you can use application.substitute but that is case sensitive:
"Q Line" won't match "q LiNE"

Option Explicit
Sub testme97()

Dim myKeyWords As Variant
Dim myRng As Range
Dim myCell As Range
Dim iCtr As Long

myKeyWords = Array("Q Line", "120 VAC")

With ActiveSheet
Set myRng = Selection

If myRng.Cells.Count > 1 Then
'do nothing
Else
'make it a multicell range
Set myRng = Union(myRng, _
.Cells.SpecialCells(xlCellTypeLastCell).Offset(1, 1))
End If

For iCtr = LBound(myKeyWords) To UBound(myKeyWords)
myRng.Replace what:=myKeyWords(iCtr), _
replacement:=UCase(myKeyWords(iCtr)), lookat:=xlPart, _
MatchCase:=False
Next iCtr

For Each myCell In myRng.Cells
For iCtr = LBound(myKeyWords) To UBound(myKeyWords)
myCell.Value = Application.Substitute(myCell.Value, _
UCase(myKeyWords(iCtr)), _
" ")
Next iCtr
myCell.Value = Application.Trim(myCell.Value)
Next myCell
End With
End Sub

Just to make clear...

myrng.replace will work in both versions.

But this:

myCell.Value = Replace(expression:=myCell.Value, _
Find:=UCase(myKeyWords(iCtr)), _
Replace:=" ", _
Start:=1, _
Count:=-1, _
compare:=vbTextCompare)

needs xl2k or higher.

 

[Tom Ogilvy]

for the specific problem you demonstrate, this should work:

Sub ReplaceData()
Dim i as Long myKeyWords as Variant
myKeyWords = Array("Q Line ", "120 VAC ", "Q Line", "120 VAC")
for i = lbound(myKeyWords) to ubound(myKeyWords)
columns("G").Replace What:=myKeyWords(i), _
Replacement:="", _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
MatchCase:=False
Next
End sub

in any version of excel.

 

[Dave Peterson]

Yep.

for the specific problem you demonstrate, this should work:

Sub ReplaceData()
Dim i as Long myKeyWords as Variant
myKeyWords = Array("Q Line ", "120 VAC ", "Q Line", "120 VAC")
for i = lbound(myKeyWords) to ubound(myKeyWords)
columns("G").Replace What:=myKeyWords(i), _
Replacement:="", _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
MatchCase:=False
Next
End sub

in any version of excel.

 

[Guest]

Thanks to all who responded.

You guys ROCK!