Excel Find & Replace Last n Characters in a Cell 2

[Pugman]

Brand new to VBA. I've been asked to develop macros to clean up Excel's PROPER function on mailing lists. I'm almost done but I'm stuck on how to tell Excel to replace the last 3 characters only of the following street address:

400 W Selby Ave Se 'The Se at the end should be SE

My code (from the macro recorder)

Sub AddressFix()
    Columns("N:N").Select
    Selection.Replace What:=" Se", Replacement:=" SE", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
        ReplaceFormat:=False
End Sub

changes Selby to SElby as well as Se to SE.

I'm hoping this is an easy solution.

Note: I have Ne, Nw and Sw to deal with also.

Thanks

 

[shVBA]

Just A suggestion but would it work if you wrote:

Sub AddressFix()
    Columns("N:N").Select
    Selection.Replace What:=" Se ", Replacement:=" SE ", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
        ReplaceFormat:=False
End Sub

This may not work as there may be no spaces after the se but maybe woth a go...

 

[Bong]

set rngA=columns("N")
for each c in rngA.cells
  if instr(1,c.text,"Se")=len(c.text)-2 then
    c=left(c.text,len(c.text)-2) & "SE"
  end if
next

_________________
Bob Rashkin

 

[Pugman]

Thanks, but no luck yet.

smherron, I already have a replace for " Se " because some addresses are like 127 Se Pkwy. With the spaces around Se it works great.

Bong, I copied and pasted your macro and ran it. It didn't change anything but it also didn't give me an error.

Any other ideas?

 

[Danp129]

try this

Dim cell As Range
Dim arChange() As String
Dim i As Long

arChange = Split("Ne Se Sw Nw")

For i = 0 To UBound(arChange)
    For Each cell In Range("n1:n" & Cells.SpecialCells(xlCellTypeLastCell).Row)
        If Right(cell, 2) = arChange(i) Then cell = Left(cell.Value, Len(cell.Value) - 2) & UCase(arChange(i))
    Next 'cell
Next 'i

 

[SkipVought]

Hi,

First set up a TABLE like
[tt]
CapAbbrev
Ne
Nw
Se
Sw
[/tt]
Then your code...

sub CleanMyAbbrev()
  dim r as range, rAbbrev as range
  for each rAbbrev in [CapAbbrev]
    Columns("N:N").Replace What:=" " & rAbbrev & " ", Replacement:=" " & UCase(rAbbrev) & " ", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
        ReplaceFormat:=False
  next
  for each r in columns("N:N")
    for each rAbbrev in [CapAbbrev]
       if right(r.value,3) = " " & rAbbrev then
          r.value = left(r.value, len(r.value)-3) & " " & UCase(rAbbrev)
       end if
    next
  next
end sub

Skip,
[sub]
Have you heard that the roundest knight at King Arthur's round table was...
Sir Cumference![/sub]

 

[Pugman]

Hi Danp129, thanks for your response. Your code didn't produce any errors but it didn't change anything.

Skip, I've been trying to get yours to work because I didn't want to have to come back and ask "How do you make the table?". I tried Data -> Table with the text you gave and all I get is a 'Input cell reference is not valid' no matter what I try. In a feeble attempt to redeem myself and not appear to be too much of a moron, the code (partial) below is what I use for the bulk of this project.

Sub fixProper()
Dim CurrentWB As String
Dim CurrentSheetName As String
Dim rng1 As Range, rng2 As Range
Dim cell As Range

CurrentWB = ActiveWorkbook.Name
CurrentSheetName = ActiveSheet.Name

With Workbooks(CurrentWB).Worksheets(CurrentSheetName)
Set rng1 = .Range(.Cells(2, 15), _
.Cells(Rows.Count, 15).End(xlUp))
End With

With Workbooks("GHD_Main.xls").Worksheets("Addr")
Set rng2 = .Range(.Cells(1, 1), _
.Cells(Rows.Count, 1).End(xlUp))
End With

For Each cell In rng2
   rng1.Replace _
     What:=cell, _
     Replacement:=cell.Offset(0, 1), _
     LookAt:=xlPart, _
     SearchOrder:=xlByRows, _
     MatchCase:=True
Next cell

End Sub

I keep the macros in a separate Excel file. This file also has worksheets named "Mac" "Mc" "O" "Addr", etc. which have 2 columns. Column A has the string to search for and Column B has the replacement string like this:

7Th 7th
8Th 8th
Se SE

I could have one worksheet with all the search/replace pairs but I found it to be slower that way.

Anyway, can this code be modified to to do the " Se" type replacements at the end of a cell? If not, could you tell me how to make the table? And finally, if the table is the way to go, can I use a macro to create it automatically?

Thanks so much...

 

[SkipVought]

Actually creating the table is not the issue. The issue is Creating Names. Sorry that I failed to stipulate that I was using a Named Range.

Select the table, heading and values.

Insert > Name > Create - Create names in TOP row

Now you have a Named Range.

Skip,
[sub]
Have you heard that the roundest knight at King Arthur's round table was...
Sir Cumference![/sub]

 

[Bong]

oops.

set rngA=columns("N")
for each c in rngA.cells
  if instr([red]len(c.text)-4[/red],c.text,"Se")=len(c.text)-[red]1[/red] then
    c=left(c.text,len(c.text)-2) & "SE"
  end if
next

_________________
Bob Rashkin

 

[Pugman]

Hi Skip,

Now I get a "type mismatch" error on the following line:

If Right(r.Value, 3) = " " & rAbbrev Then

 

[Pugman]

Hi Bong,

Your new code still didn't do it. It runs without errors but nothing is replaced.

 

[SkipVought]

try this...

  for each r in columns("N:N")[b]
    if r.value <> "" then[/b]
      for each rAbbrev in [CapAbbrev]
         if right(r.value,3) = " " & rAbbrev then
            r.value = left(r.value, len(r.value)-3) & " " & UCase(rAbbrev)
         end if
      next[b]
    end if[/b]
  next

Skip,
[sub]
Have you heard that the roundest knight at King Arthur's round table was...
Sir Cumference![/sub]

 

[Pugman]

Sorry Skip,

I now get a "type mismatch" error on the following:

If r.Value <> "" Then

 

[SkipVought]

DEBUG: What is the VALUE of r.value when it throws the error?

Skip,
[sub]
Have you heard that the roundest knight at King Arthur's round table was...
Sir Cumference![/sub]

 

[Pugman]

Please remember I'm new at this. Debugging isn't something I've used yet.

After clciking on Debug, do I hover the cursor over it? If I hover the cursor over rAbbrev it pops up with "rAbbrev = Nothing". If this how to do it then r.Value doesn't pop up anything.

I added a Watch to that line and that gives me a bunch of values under r.Value like r.Value(1) is "Address1" and r.Value(2) is "2701 University Ave Se", etc. I'm playing with a 7 row file but the r.Value keeps incrementing up to the max rows (65536) and everything after my 7 rows states the value as Empty.

Please let me know if I'm not debugging correctly and thanks again.

 

[SkipVought]

r.Value(1) is "Address1" and r.Value(2) is "2701 University

PROBLEM!!!

r should contain ONE and only ONE value.

Please post your code.




Skip,
[sub]
Have you heard that the roundest knight at King Arthur's round table was...
Sir Cumference![/sub]

 

[Pugman]

Here it is. I think it's all your code, meaning I didn't mess with it.

Sub CleanMyAbbrev()
  Dim r As Range, rAbbrev As Range
  For Each rAbbrev In [CapAbbrev]
    Columns("N:N").Replace What:=" " & rAbbrev & " ", Replacement:=" " & UCase(rAbbrev) & " ", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
        ReplaceFormat:=False
  Next
  For Each r In Columns("N:N")
    If r.Value <> "" Then
      For Each rAbbrev In [CapAbbrev]
         If Right(r.Value, 3) = " " & rAbbrev Then
            r.Value = Left(r.Value, Len(r.Value) - 3) & " " & UCase(rAbbrev)
         End If
      Next
    End If
  Next

End Sub

 

[SkipVought]

use this instead

  For Each r In Range(Cells(1, "N"), Cells(65536, "N"))
...

Skip,
[sub]
Have you heard that the roundest knight at King Arthur's round table was...
Sir Cumference![/sub]

 

[Pugman]

That was it! Thank you Skip.

I really appreciate all the help.

 

[PHV]

Another way was to replace this:
For Each r In Columns("N:N")
with this:
For Each r In Columns("N:N").Cells

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886