Shorter code

[Adrie Rahanra]

Hello group,

Can somebody tell me which method to use to shorten this
code. Thanx.

@3

Sub Find_and_Replace()
Selection.Replace What:="-", Replacement:=" ",
LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
Selection.Replace What:="CND ", Replacement:="",
LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
Selection.Replace What:="SPO ", Replacement:="",
LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
Selection.Replace What:="SWA ", Replacement:="",
LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
Selection.Replace What:="OUT ", Replacement:="",
LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
Selection.Replace What:="ROL ", Replacement:="",
LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
Selection.Replace What:="BCA ", Replacement:="BANCA ",
LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
Selection.Replace What:="BCO ", Replacement:="BANCO ",
LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
Selection.Replace What:="BK ", Replacement:="BANK ",
LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
Selection.Replace What:="BNK ", Replacement:="BANK ",
LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
Selection.Replace What:="BQ ", Replacement:="BANQUE ",
LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
Selection.Replace What:="CR ", Replacement:="CREDIT ",
LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
Selection.Replace What:="DEUT ",
Replacement:="DEUTSCHE ", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
Selection.Replace What:="NAT ",
Replacement:="NATIONAL ", LookAt:=xlPart _
, SearchOrder:=xlByRows, MatchCase:=False
Selection.Replace What:="RAIFF ",
Replacement:="RAIF ", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
Selection.Replace What:="ROY ", Replacement:="ROYAL ",
LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
Selection.Replace What:="SOC ",
Replacement:="SOCIETE ", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
End Sub

 

[Bob Phillips]

Sub Find_and_Replace()
pzReplace pFrom:="-", pTo:=" "
pzReplace pFrom:="CND ", pTo:=""
pzReplace pFrom:="SPO ", pTo:=""
pzReplace pFrom:="SWA ", pTo:=""
pzReplace pFrom:="OUT ", pTo:=""
pzReplace pFrom:="ROL ", pTo:=""
pzReplace pFrom:="BCA ", pTo:="BANCA "
pzReplace pFrom:="BCO ", pTo:="BANCO "
pzReplace pFrom:="BK ", pTo:="BANK "
pzReplace pFrom:="BNK ", pTo:="BANK "
pzReplace pFrom:="BQ ", pTo:="BANQUE "
pzReplace pFrom:="CR ", pTo:="CREDIT "
pzReplace pFrom:="DEUT ", pTo:="DEUTSCHE "
pzReplace pFrom:="NAT ", pTo:="NATIONAL "
pzReplace pFrom:="RAIFF ", pTo:="RAIF "
pzReplace pFrom:="ROY ", pTo:="ROYAL "
pzReplace pFrom:="SOC ", pTo:="SOCIETE "
End Sub

Private Sub pzReplace(pFrom, pTo)
Selection.pzReplace What:=pFrom, _
pzReplacement:=pTo, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
MatchCase:=False

End Sub

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

 

[Nikos Yannacopoulos]

Adrie,

Suppose you use an auxiliary sheet to hold your substitutions; I'll assume
the sheet is called "Subst", and starting row 2, column A holds the find
what values while column B holds the replace with values (with no blank rows
in between). Then your code could be something like:

Sub Find_and_Replace()
Dim Dictnry As Range
Dim fw As String, rw As String

Set Dictnry = Range("'Sheet1'!A2")
Set Dictnry = Range(Dictnry, Dictnry.End(xlDown))

For Each cell In Dictnry
fw = cell.Value
rw = cell.Offset(0, 1).Value
Selection.Replace What:=fw, Replacement:=rw, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=FalseNext
Next

End Sub

This is written so you can add to the end of the substitutes list at any
time, and the next time it runs it will pick up the additions.

HTH,
Nikos

 

[Adrie Rahanra]

Thanx Bob!

-----Original Message-----
Sub Find_and_Replace()
pzReplace pFrom:="-", pTo:=" "
pzReplace pFrom:="CND ", pTo:=""
pzReplace pFrom:="SPO ", pTo:=""
pzReplace pFrom:="SWA ", pTo:=""
pzReplace pFrom:="OUT ", pTo:=""
pzReplace pFrom:="ROL ", pTo:=""
pzReplace pFrom:="BCA ", pTo:="BANCA "
pzReplace pFrom:="BCO ", pTo:="BANCO "
pzReplace pFrom:="BK ", pTo:="BANK "
pzReplace pFrom:="BNK ", pTo:="BANK "
pzReplace pFrom:="BQ ", pTo:="BANQUE "
pzReplace pFrom:="CR ", pTo:="CREDIT "
pzReplace pFrom:="DEUT ", pTo:="DEUTSCHE "
pzReplace pFrom:="NAT ", pTo:="NATIONAL "
pzReplace pFrom:="RAIFF ", pTo:="RAIF "
pzReplace pFrom:="ROY ", pTo:="ROYAL "
pzReplace pFrom:="SOC ", pTo:="SOCIETE "
End Sub

Private Sub pzReplace(pFrom, pTo)
Selection.pzReplace What:=pFrom, _
pzReplacement:=pTo, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
MatchCase:=False

End Sub

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)




.