replace string

[hoysala]

hi all

i need to replace the string in column c. For ex the string DOOR INSTL
should be converted to DOOR INSTALATION. DOOR ASSY to convert it to
DOOR ASSEMBLY

i have written a code which changes INSTL to INSTALLATION and so on.
i have huge list of these conversion

My problem is that have written thin in code.

Can we have a code which will refer to sheet 2 and replace a part of
the text string ?

Code is as below.



For new word start copy of the below block of code
If (InStr(1, .Value, " INSTL ", vbTextCompare) > 0) Then
'Please assign the new word here with leading and
trailing whitespace
myWord = " INSTL "
.Characters(Start:=InStr(1, .Value, myWord,
vbTextCompare), Length:=Len(myWord)).Text = " INSTALLATION "
ElseIf (InStr(1, .Value, "INSTL ", vbTextCompare) > 0)
Then
'Please assign the new word here with trailing white
space
myWord = "INSTL "
intStart = InStr(1, .Value, myWord, vbTextCompare) - 1
If intStart = 0 Then
.Characters(Start:=InStr(1, .Value, myWord,
vbTextCompare), Length:=Len(myWord)).Text = "INSTALLATION "
End If
ElseIf (InStr(1, .Value, " INSTL", vbTextCompare) > 0)
Then
'Please assign the new word here with leading white
space
myWord = " INSTL"
intStart = InStr(1, .Value, myWord, vbTextCompare) +
Len(myWord) - 1
intCellValLength = Len(rCell.Value)
If (intCellValLength = intStart) Then
.Characters(Start:=InStr(1, .Value, myWord,
vbTextCompare), Length:=Len(myWord)).Text = " INSTALLATION"
End If
ElseIf (InStr(1, UCase(.Value), "INSTL", vbTextCompare) >
0) Then
'Please assign the new word here without leading and
trailing white space
myWord = "INSTL"
If (UCase(rCell.Value) = myWord) Then
.Characters(Start:=InStr(1, .Value, myWord,
vbTextCompare), Length:=Len(myWord)).Text = "INSTALLATION"
End If
End If

 

[Per Jessen]

hi all

i need to replace the string in column c. For ex the string DOOR INSTL
should be converted to DOOR INSTALATION. DOOR ASSY to convert it to
DOOR ASSEMBLY

i have written a code which changes INSTL to INSTALLATION and so on.
i have huge list of these conversion

My problem is that have written thin in code.

Can we have a code which will refer to sheet 2 and replace a part of
the text string ?

Code is as below.



For new word start copy of the below block of code
If (InStr(1, .Value, " INSTL ", vbTextCompare) > 0) Then
'Please assign the new word here with leading and
trailing whitespace
myWord = " INSTL "
.Characters(Start:=InStr(1, .Value, myWord,
vbTextCompare), Length:=Len(myWord)).Text = " INSTALLATION "
ElseIf (InStr(1, .Value, "INSTL ", vbTextCompare) > 0)
Then
'Please assign the new word here with trailing white
space
myWord = "INSTL "
intStart = InStr(1, .Value, myWord, vbTextCompare) - 1
If intStart = 0 Then
.Characters(Start:=InStr(1, .Value, myWord,
vbTextCompare), Length:=Len(myWord)).Text = "INSTALLATION "
End If
ElseIf (InStr(1, .Value, " INSTL", vbTextCompare) > 0)
Then
'Please assign the new word here with leading white
space
myWord = " INSTL"
intStart = InStr(1, .Value, myWord, vbTextCompare) +
Len(myWord) - 1
intCellValLength = Len(rCell.Value)
If (intCellValLength = intStart) Then
.Characters(Start:=InStr(1, .Value, myWord,
vbTextCompare), Length:=Len(myWord)).Text = " INSTALLATION"
End If
ElseIf (InStr(1, UCase(.Value), "INSTL", vbTextCompare) >
0) Then
'Please assign the new word here without leading and
trailing white space
myWord = "INSTL"
If (UCase(rCell.Value) = myWord) Then
.Characters(Start:=InStr(1, .Value, myWord,
vbTextCompare), Length:=Len(myWord)).Text = "INSTALLATION"
End If
End If

Hi

I assume that the text you want to manipulate is in sheet1 column C. In
sheet2 we have text to replace in column A and text to convert to in column
B.

Sub Test()

Dim sStringRange As Range
Dim sString As String
Dim rString As String
Dim c As Variant

Sheet2.Activate
Set sStringRange = Sheet2.Range("A1", Range("A1").End(xlDown))
Sheet1.Activate
For Each c In sStringRange
With Sheet2
sString = c.Value
rString = c.Offset(0, 1).Value
End With
Columns(3).Replace What:=sString, Replacement:=rString, LookAt:=xlPart,
SearchOrder:=xlByRows, MatchCase:=False
Next
End Sub

Regards,

Per

 

[Rick Rothstein \(MVP - VB\)]

Give this macro a try...

Sub ExpandAbbreviations()
Dim C As Range
Dim R As Range
Set R = ActiveSheet.Range("C1:C" & Cells(Rows.Count, "C").End(xlUp))
For Each C In R
If C.Value Like "*INSTL*" Then
C.Value = Replace(C.Text, "INSTL", "INSTALLATION")
ElseIf C.Value Like "*ASSY*" Then
C.Value = Replace(C.Text, "ASSY", "ASSEMBLY")
End If
Next
End Sub

Rick

 

[Dave Peterson]

I think it would be lots quicker to do a series of edit|replaces.

Start a new workbook--its only purpose is to hold the macro and the list of
words/phrases to be replaced and the list to be used for the replacement.

Then put your list in Column A and column B of sheet1 of that workbook.

Put this macro in that workbook's project in a general module--not behind a
worksheet, not behind ThisWorkbook.

Option Explicit
Sub MassChanges()

Dim myCell As Range
Dim myList As Range

With ThisWorkbook.Worksheets("Sheet1")
Set myList = .Range("a1", .Cells(.Rows.Count, "A").End(xlUp))
End With

With ActiveSheet
For Each myCell In myList.Cells
.Cells.Replace _
what:=myCell.Value, _
replacement:=myCell.Offset(0, 1).Value, _
lookat:=xlPart, _
searchorder:=xlByRows, _
MatchCase:=False
Next myCell
End With

End Sub

After you've done this, you can save this workbook.

Whenever you need to ammend the list, just type over the entries or add new or
delete old.

When ever you need to run the macro, open this workbook.

Activate the real workbook/worksheet and use alt-f8 to run this macro.