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")

Befo
Q Line THQB 120 VAC 1 pole 20A

After:
THQB 1 pole 20A

Thanks in advance!

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


"Scott Wagner" wrote in
message
...
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")

Befo
Q Line THQB 120 VAC 1 pole 20A

After:
THQB 1 pole 20A

Thanks in advance!

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


"Chip Pearson" wrote in message
...
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


"Scott Wagner" wrote in
message
...
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")

Befo
Q Line THQB 120 VAC 1 pole 20A

After:
THQB 1 pole 20A

Thanks in advance!

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, _
compa=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, _
compa=vbTextCompare)

needs xl2k or higher.

Scott Wagner wrote:

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")

Befo
Q Line THQB 120 VAC 1 pole 20A

After:
THQB 1 pole 20A

Thanks in advance!

--

Dave Peterson

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.

--
Regards,
Tom Ogilvy



"Dave Peterson" wrote in message
...
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, _
compa=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, _
compa=vbTextCompare)

needs xl2k or higher.

Scott Wagner wrote:

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")

Befo
Q Line THQB 120 VAC 1 pole 20A

After:
THQB 1 pole 20A

Thanks in advance!

--

Dave Peterson

Yep.

Tom Ogilvy wrote:

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.

--
Regards,
Tom Ogilvy

"Dave Peterson" wrote in message
...
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, _
compa=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, _
compa=vbTextCompare)

needs xl2k or higher.

Scott Wagner wrote:

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")

Befo
Q Line THQB 120 VAC 1 pole 20A

After:
THQB 1 pole 20A

Thanks in advance!

--

Dave Peterson

--

Dave Peterson

Thanks to all who responded.

You guys ROCK!