Delete 2 chars, replace them, and capitalize the next character

[Derf]

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]

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]

Works great, Graham. Thanks so much!