If possible, I'd like to some help with a macro that strips the address number from a Parcel Address and leaves only the street name left.

Before:
1234 Somewhere St.
321 Crossing Meadows Dr.


After:
Somewhere St.
Crossing Meadows Dr.

Thanks,
SKK

If possible, I'd like to some help with a macro that strips the address number from a Parcel Address and leaves only the street name left.

Before:
1234 Somewhere St.
321 Crossing Meadows Dr.


After:
Somewhere St.
Crossing Meadows Dr.

Thanks,
SKK

I can offer a helping hand on this one but it is done though a query if this is any good let me know and i will tell you how to do it

Of course. My fault...
I have a query for other items.

SKK

Of course. My fault...
I have a query for other items.

SKK

First the modules

1) Module Name Address Break Down

Option Compare Database

Function ReplaceQ(pString1 As String, pFind As String, pReplacement As String) As String

ReplaceQ = Replace(pString1, pFind, pReplacement)

End Function

2) Module Name MOD_Siteline
Option Compare Database
Option Explicit


Public Function SiteLine(strSite As String, intLine) As String
Dim strLine(4) As String, lngLoop As Long
Dim lngFirstComma As Long, lngLastComma As Long

On Error GoTo TextError

lngLoop = 1

Do

lngLastComma = InStr(strSite, ",")

If lngLastComma = 0 Then lngLastComma = Len(strSite)

strLine(lngLoop) = Left$(strSite, lngLastComma)

strSite = Right$(strSite, Len(strSite) - Len(strLine(lngLoop)))

lngLoop = lngLoop + 1

Loop Until lngLoop = 4 Or Len(strSite) < 1

strLine(lngLoop) = strSite

If Left$(strLine(intLine), 1) = " " Then
SiteLine = Right$(strLine(intLine), Len(strLine(intLine)) - 1)
Else
SiteLine = strLine(intLine)
End If

Exit Function

TextError:
SiteLine = ""

End Function
Public Function FullLocation(lngLocationID As Long) As String

Dim dbs As Database, rstLocations As Recordset

On Error GoTo NoLocation

Set dbs = CurrentDb

FullLocation = RecurseLocation(lngLocationID, dbs)

NoLocation:

End Function
Public Function RecurseLocation(lngLocationID As Long, dbs As Database) As String

Dim strLocation As String, lngParentID As Long

On Error GoTo NullLocation

strLocation = DLookup("Label", "Locations", "LocationID =" & lngLocationID)
lngParentID = DLookup("ParentID", "Locations", "LocationID =" & lngLocationID)

If lngParentID > 1 Then
strLocation = strLocation & ", " & RecurseLocation(lngParentID, dbs)
Else
strLocation = strLocation & "."
End If

RecurseLocation = strLocation

Exit Function

NullLocation:
RecurseLocation = ""

End Function

3) Module Name tbExtractStringFunctions

Option Compare Database 'Use database order for string comparisons


Function tbExtractStr(strIn, intNeedSegment, strDelimiter, Optional strNotFound As String) As String

' Function to chop a input string into segments and return the requested segment
' Written and developed by Thomas M. Brittell
' Copyright 1998; All rights reserved.
'
' strIn - Input string to be segmented
' intNeedSegment - Indicates the segment to be returned
' strDelimiter - The delimiter used to seperate each segment
' strNotFound - When no segment is found return the specified string if provided
'

Dim intCurrentPosition As Integer
Dim intFoundPosition As Integer
Dim intLastPosition As Integer
Dim intGetSegment As Integer
Dim wrkNotFound As String

If IsEmpty(strNotFound) Or strNotFound = "" Then
wrkNotFound = ""
Else
wrkNotFound = strNotFound
End If

intCurrentPosition = 0
intFoundPosition = 0
intLastPosition = 0
intGetSegment = intNeedSegment

Do While intGetSegment > 0
intLastPosition = intCurrentPosition
'Find a occurance of the delimiter
intFoundPosition = InStr(intCurrentPosition + 1, strIn, Left$(strDelimiter, 1))
If intFoundPosition > 0 Then
intCurrentPosition = intFoundPosition
intGetSegment = intGetSegment - 1
Else
'End of input string so exit
intCurrentPosition = Len(strIn) + 1
Exit Do
End If
Loop
'If nothing was found and you had at least one delimiter return ""
If (intFoundPosition = 0) And ((intGetSegment <> intNeedSegment) And (intGetSegment > 1)) Then
tbExtractStr = wrkNotFound
Else
'Return the segment between the last position and the current one
tbExtractStr = Mid$(strIn, intLastPosition + 1, intCurrentPosition - intLastPosition - 1)
End If

End Function
---------------------------------------------------------------------------

You will need to design a query to call the modules use the following line
Name1: tbExtractStr([Address],[intSegment1],", ","Nothing Found")

This will take the first section ie "1234"

then by moving the "intsegment" on one number it will do other parts of your address.

Hope this helps you.

Alastair

Great - will try (it's actually for someone in planning).

Thanks Alastair,
SKK

Hey all...
I think I got it. I have an update query:

Right([Par_Addr],(Len([Par_Addr])-InStr([Par_Addr]," ")))

It may not be correct but it appears to be doing what I want.
Thanks again,
SKK

SKK
What you have will work OK as long as there is always a House Number.
What happens if there is a House Name rather than number?

Peter