Log in

View Full Version : Delete 2 chars, replace them, and capitalize the next character



Derf
06-22-2018, 08:31 AM
Hi, all,

I frequently edit police reports for publication and have to remove exact addresses and replace them. For example, I take "1313 Mockingbird Lane" and change it to "1300 block of Mockingbird Lane". (The bold is the stuff that never changes.) Also, the police tend to write in all caps, no caps, or some weird combination, so I would already have converted everything to Sentence Case, which means that in that construction, the street name would be lower case. So I'd like to have it automatically capitalize the street name (which could begin with any letter).

Thanks in advance!

gmayor
06-22-2018, 08:27 PM
Because of the variabilty of street names it would not be possible to do all this - especially with regard to the capitalisation. Does for example the street name have one word, two or three ... or more words? If you are going to have to select the whole street address in order to format the case, then you might just as easily set the case with the built-in keyboard shortcut.

The rest can be done. Put the cursor in the number and run the following. It will work with street numbers of three digits or more. If the cursor is not in a number you will get a warning message. If you have run the macro on the address previously the additional text is not duplicated.


Sub SetBlock()
'Graham Mayor - http://www.gmayor.com - Last updated - 23 Jun 2018
Dim i As Long
Dim oRng As Range
Set oRng = Selection.Words(1)
If Not IsNumeric(oRng.Text) Then
MsgBox "The cursor is not in a number!"
GoTo lbl_Exit
End If
oRng.End = oRng.End - 1
If Len(oRng) > 2 Then
oRng.Start = oRng.Start + 2
For i = 1 To Len(oRng)
oRng.Characters(i) = "0"
Next i
oRng.End = oRng.End + 1
If Not Trim(oRng.Words.Last.Next.Words(1)) = "block" Then
oRng.Collapse 0
oRng.Text = " block of"
oRng.End = oRng.End + 1
oRng.Collapse 0
oRng.Characters(1).Case = wdUpperCase
End If
End If
lbl_Exit:
Set oRng = Nothing
Exit Sub
End Sub

Derf
06-25-2018, 07:36 AM
Works great, Graham. Thanks so much!