How about list the "bad" abbreviations in column A and the good replacements in
column B of that sheet.

dr Drive
dr. Drive
st Street
st. Street
....

Then you could use a macro like this:

Option Explicit

Sub FindReplaceAddressAbreviations2()
Dim myAbbrList As Range
Dim myAbbrCell As Range
Dim myAbbrStr As String
Dim myCell As Range

With Worksheets("abbreviations")
Set myAbbrList = .Range("a1", .Cells(.Rows.Count, "A").End(xlUp))
End With

For Each myCell In Selection.Cells
For Each myAbbrCell In myAbbrList.Cells
myAbbrStr = " " & LCase(myAbbrCell.Value)
If LCase(Right(myCell, Len(myAbbrStr))) = myAbbrStr Then
'found one
myCell.Value = Left(myCell.Value, _
Len(myCell.Value) - Len(myAbbrStr)) _
& " " & myAbbrCell.Offset(0, 1).Value
Exit For 'stop looking
End If
Next myAbbrCell
Next myCell
End Sub

I personally like a list that easy to maintain--I can delete rows without
thinking too much and I can add rows, too.

Josh O. wrote:

Just for some more explaination. Here is the macro I am using now:

Sub FindReplaceAddressAbreviations()
Dim mycell As Range
For Each mycell In Selection
If LCase(Right(mycell, 3)) = " dr" Then
mycell = Left(mycell, Len(mycell) - 3) & " Drive"
End If
If LCase(Right(mycell, 4)) = " dr." Then
mycell = Left(mycell, Len(mycell) - 4) & " Drive"
End If
If LCase(Right(mycell, 3)) = " st" Then
mycell = Left(mycell, Len(mycell) - 3) & " Street"
End If
If LCase(Right(mycell, 4)) = " st." Then
mycell = Left(mycell, Len(mycell) - 4) & " Street"
End If
Next mycell
End Sub

The problem that I have is that I have to write in every possibility and
variation. And like I mention below, if I could list the Desired result in
Column A, and list the variants that I want replaced in the cells to the
right...then have the marco search for the "replacement values" and
substitute the desired result...that would be ideal.

But I don't know enough about the syntax to make it work. Any help would be
appreciated.

"Josh O." wrote:

Is it possible to have a find and replace macro run based on a hidden
worksheet with a dynamic changing list?

For example,
If a text string contains any value in 'Hidden Sheet' B2:IV2, replace with
'Hidden Sheet' A2. Or if it equals any value in B3:IV3, replace with A3 and
so on.

A2=100, B2=25, C2=80, D2=19
A3=200, B3=29, C3=99

If Right 2 digits of text string is equal to any number in cell B2 or over,
Replace with "100", or if Right 2 digits of string equal anything in cells A3
or over, Replace with "200".

--

Dave Peterson

Sure.

This line:
With Worksheets("abbreviations")
would become
With ThisWorkbook.Worksheets("abbreviations")

And change that worksheet name (Abbreviations) to the real name of the
worksheet.

You may want to change that workbook with the macro as an addin. It'll open
hidden away from the user. But you'll want to give the user (you???) a way to
run the macro.

Here's how I do it when I want a toolbar:
http://www.contextures.com/xlToolbar02.html
(from Debra Dalgleish's site)



Josh O. wrote:

Is it possible to have the actual list saved in the workbook with the Macro
and keep the workbook hidden?

The macro will be used with various different lists outside of the Macro's
Workbook.

"Josh O." wrote:

Dave,
The macro is giving me an error at the With Worksheets("abbreviations").
Error: Run-time Error '9': Subscript out of range.

"Dave Peterson" wrote:

How about list the "bad" abbreviations in column A and the good replacements in
column B of that sheet.

dr Drive
dr. Drive
st Street
st. Street
....

Then you could use a macro like this:

Option Explicit

Sub FindReplaceAddressAbreviations2()
Dim myAbbrList As Range
Dim myAbbrCell As Range
Dim myAbbrStr As String
Dim myCell As Range

With Worksheets("abbreviations")
Set myAbbrList = .Range("a1", .Cells(.Rows.Count, "A").End(xlUp))
End With

For Each myCell In Selection.Cells
For Each myAbbrCell In myAbbrList.Cells
myAbbrStr = " " & LCase(myAbbrCell.Value)
If LCase(Right(myCell, Len(myAbbrStr))) = myAbbrStr Then
'found one
myCell.Value = Left(myCell.Value, _
Len(myCell.Value) - Len(myAbbrStr)) _
& " " & myAbbrCell.Offset(0, 1).Value
Exit For 'stop looking
End If
Next myAbbrCell
Next myCell
End Sub

I personally like a list that easy to maintain--I can delete rows without
thinking too much and I can add rows, too.

Josh O. wrote:

Just for some more explaination. Here is the macro I am using now:

Sub FindReplaceAddressAbreviations()
Dim mycell As Range
For Each mycell In Selection
If LCase(Right(mycell, 3)) = " dr" Then
mycell = Left(mycell, Len(mycell) - 3) & " Drive"
End If
If LCase(Right(mycell, 4)) = " dr." Then
mycell = Left(mycell, Len(mycell) - 4) & " Drive"
End If
If LCase(Right(mycell, 3)) = " st" Then
mycell = Left(mycell, Len(mycell) - 3) & " Street"
End If
If LCase(Right(mycell, 4)) = " st." Then
mycell = Left(mycell, Len(mycell) - 4) & " Street"
End If
Next mycell
End Sub

The problem that I have is that I have to write in every possibility and
variation. And like I mention below, if I could list the Desired result in
Column A, and list the variants that I want replaced in the cells to the
right...then have the marco search for the "replacement values" and
substitute the desired result...that would be ideal.

But I don't know enough about the syntax to make it work. Any help would be
appreciated.

"Josh O." wrote:

Is it possible to have a find and replace macro run based on a hidden
worksheet with a dynamic changing list?

For example,
If a text string contains any value in 'Hidden Sheet' B2:IV2, replace with
'Hidden Sheet' A2. Or if it equals any value in B3:IV3, replace with A3 and
so on.

A2=100, B2=25, C2=80, D2=19
A3=200, B3=29, C3=99

If Right 2 digits of text string is equal to any number in cell B2 or over,
Replace with "100", or if Right 2 digits of string equal anything in cells A3
or over, Replace with "200".

--

Dave Peterson


--

Dave Peterson

You may want to change that workbook with the macro as an addin.
should have been:
You may want to SAVE that workbook with the macro as an addin.

Just File|SaveAs and choose addin from the "save as type" box.

Dave Peterson wrote:

Sure.

This line:
With Worksheets("abbreviations")
would become
With ThisWorkbook.Worksheets("abbreviations")

And change that worksheet name (Abbreviations) to the real name of the
worksheet.

You may want to change that workbook with the macro as an addin. It'll open
hidden away from the user. But you'll want to give the user (you???) a way to
run the macro.

Here's how I do it when I want a toolbar:
http://www.contextures.com/xlToolbar02.html
(from Debra Dalgleish's site)

Josh O. wrote:

Is it possible to have the actual list saved in the workbook with the Macro
and keep the workbook hidden?

The macro will be used with various different lists outside of the Macro's
Workbook.

"Josh O." wrote:

Dave,
The macro is giving me an error at the With Worksheets("abbreviations").
Error: Run-time Error '9': Subscript out of range.

"Dave Peterson" wrote:

How about list the "bad" abbreviations in column A and the good replacements in
column B of that sheet.

dr Drive
dr. Drive
st Street
st. Street
....

Then you could use a macro like this:

Option Explicit

Sub FindReplaceAddressAbreviations2()
Dim myAbbrList As Range
Dim myAbbrCell As Range
Dim myAbbrStr As String
Dim myCell As Range

With Worksheets("abbreviations")
Set myAbbrList = .Range("a1", .Cells(.Rows.Count, "A").End(xlUp))
End With

For Each myCell In Selection.Cells
For Each myAbbrCell In myAbbrList.Cells
myAbbrStr = " " & LCase(myAbbrCell.Value)
If LCase(Right(myCell, Len(myAbbrStr))) = myAbbrStr Then
'found one
myCell.Value = Left(myCell.Value, _
Len(myCell.Value) - Len(myAbbrStr)) _
& " " & myAbbrCell.Offset(0, 1).Value
Exit For 'stop looking
End If
Next myAbbrCell
Next myCell
End Sub

I personally like a list that easy to maintain--I can delete rows without
thinking too much and I can add rows, too.

Josh O. wrote:

Just for some more explaination. Here is the macro I am using now:

Sub FindReplaceAddressAbreviations()
Dim mycell As Range
For Each mycell In Selection
If LCase(Right(mycell, 3)) = " dr" Then
mycell = Left(mycell, Len(mycell) - 3) & " Drive"
End If
If LCase(Right(mycell, 4)) = " dr." Then
mycell = Left(mycell, Len(mycell) - 4) & " Drive"
End If
If LCase(Right(mycell, 3)) = " st" Then
mycell = Left(mycell, Len(mycell) - 3) & " Street"
End If
If LCase(Right(mycell, 4)) = " st." Then
mycell = Left(mycell, Len(mycell) - 4) & " Street"
End If
Next mycell
End Sub

The problem that I have is that I have to write in every possibility and
variation. And like I mention below, if I could list the Desired result in
Column A, and list the variants that I want replaced in the cells to the
right...then have the marco search for the "replacement values" and
substitute the desired result...that would be ideal.

But I don't know enough about the syntax to make it work. Any help would be
appreciated.

"Josh O." wrote:

Is it possible to have a find and replace macro run based on a hidden
worksheet with a dynamic changing list?

For example,
If a text string contains any value in 'Hidden Sheet' B2:IV2, replace with
'Hidden Sheet' A2. Or if it equals any value in B3:IV3, replace with A3 and
so on.

A2=100, B2=25, C2=80, D2=19
A3=200, B3=29, C3=99

If Right 2 digits of text string is equal to any number in cell B2 or over,
Replace with "100", or if Right 2 digits of string equal anything in cells A3
or over, Replace with "200".

--

Dave Peterson


--

Dave Peterson

--

Dave Peterson