Removal of Street Types from Address Field 2

[AndrewCorkery]

Hi

Quick question:

Address line 1
Top Ryde Shopping Centre
Blaxland Road
Blaxland Road
Charles Street
Karen Moras Drive
Blaxland Road
Ryde Tafe
Blaxland Road
Church Street


In need to strip out the Road, Street, Avenue etc out of the about field above,and place that Road, St etc etc into another field.

So the new fields would look like this:

StreetName [bType[/b]
Top Ryde Shopping Centre
Blaxland Road
Blaxland Road
Charles Street
Karen Moras Drive
Blaxland Road
Ryde Tafe
Blaxland Road
Church Street


Do you know how I could do this??


Thanks

 

[GKProgrammer]

Hi Andrew,

You could do it with a little code, the little bit of work you have to do is to fill in the values for the array below:

[red]Run from a command button[/red]
Private Sub Command10_Click()
Dim dbs As Database, rst As Recordset, tblValue As Boolean, AppValue(1 To 4) As String [red] change AppValue to number of different types [/red]
Dim cnt As Integer, retValue As String

Set dbs = CurrentDb
Set rst = dbs.OpenRecordset("Table3", dbOpenDynaset)[red]fill in your table name[/red]

AppValue(1) = "Road"
AppValue(2) = "Street"
AppValue(3) = "Drive"
AppValue(4) = "Place"[red]Add the rest of your available values[/red]
cnt = 1

With rst
.MoveFirst
Do While 1 = 1
tblValue = !Address Like "*" & AppValue(cnt) & "*"
If tblValue = True Then
retValue = modStripChr.StripChr(!Address, AppValue(cnt))
.Edit
!Address = retValue
!Type = AppValue(cnt)
.Update
.MoveNext
If .EOF = True Then Exit Do
cnt = 1
ElseIf cnt = 4 Then [red] change cnt to = # of different types[/red]
cnt = 1
.MoveNext
If .EOF = True Then Exit Do
Else
cnt = cnt + 1
End If
Loop
End With

Set rst = Nothing
dbs.Close

End Sub

Public Function StripChr(strValue As String, strChr As String) As String
Dim leng As Integer, strPos As Integer, chrPos As Integer

strPos = 1
leng = Len(strValue)
Do While 1 = 1
chrPos = InStr(strPos, strValue, strChr, Len(strChr))

If chrPos = 0 Then
StripChr = StripChr & Mid$(strValue, strPos, ((leng + 1) - strPos))
Exit Do
Else
StripChr = StripChr & Mid$(strValue, strPos, (chrPos - strPos))
End If
strPos = chrPos + Len(strChr)
Loop

End Function Regards,
gkprogrammer

 

[AndrewCorkery]

Hi,

Can't seem to get this code to work:

Get errors on:

Dim dbs as DataBase

and

.edit

Any ideas??

Thanks for your help

 

[LittleSmudge]

GK's code is written for Access 97 - or earlier as it is written in DAO.

The two lines you mention are classic fall over points if you are running Access 2k or later ( running ADO )

The first few lines of GK's code become

Dim rst As ADODB.Recordset
Set rst = New ADODB.Recordset
rst.CursorType = adOpenKeyset
rst.LockType = adLockOptimistic

tblValue As Boolean
AppValue(1 To 4) As String change AppValue to number of different types 
Dim cnt As Integer
retValue As String
    
rst.Open "SELECT * FROM Table3"   '  fill in your table name

etc..

Then just delete the .Edit line

( Pureists will tell you that the .Update line is UNnecessary now too. But I put it in as it 'self documents' what you are intending to do. )



'ope-that-'elps. G LS
accessaceNOJUNK@valleyalley.co.uk
Remove the NOJUNK to use.

Please remember to give helpful posts the stars they deserve!
This makes the post more visible to others in need! :-D

 

[AndrewCorkery]

Hi,

Thanks for your help, got a few more probs....

Getting stuck here now: (at Arrow)

Private Sub Command10_Click()

Dim rst As ADODB.Recordset
Set rst = New ADODB.Recordset
rst.CursorType = adOpenKeyset
rst.LockType = adLockOptimistic

Dim tblValue As Boolean
Dim AppValue(1 To 4) As String
Dim cnt As Integer
Dim retValue As String

rst.Open &quot;SELECT * FROM tbl_TempHolding&quot; <=== Error says: &quot;Run-Time Error 3709, The Connection cannot be used to perform this operation. It is either closed or invalid in this context.&quot;



AppValue(1) = &quot;Road&quot;
AppValue(2) = &quot;Street&quot;
AppValue(3) = &quot;Drive&quot;
AppValue(4) = &quot;Place&quot; 'Add the rest of your available values
cnt = 1

With rst
.MoveFirst
Do While 1 = 1
tblValue = !Address Like &quot;*&quot; & AppValue(cnt) & &quot;*&quot;
If tblValue = True Then
retValue = modStripChr.StripChr(!Address, AppValue(cnt))

!Address = retValue
!Type = AppValue(cnt)
.Update
.MoveNext
If .EOF = True Then Exit Do
cnt = 1
ElseIf cnt = 4 Then cnt = 4 'of different types
cnt = 1
.MoveNext
If .EOF = True Then Exit Do
Else
cnt = cnt + 1
End If
Loop
End With

Set rst = Nothing
dbs.Close

End Sub

 

[GKProgrammer]

Hi Andrew,

There is no reason why the code that I supplied won't work in Access 2000. You will require a reference to the Microsoft DAO library. While in the code module goto Tools>References then scroll down to Microsoft DAO 3.6 Object Library(Or whatever is the latest version you have)and select it. The code that I originaly supplied will work now.

Let me know if this helps. Regards,
gkprogrammer

 

[LittleSmudge]

Ooops - missed out the one important line to the Connection. - sorry

After rst.LockType = adLockOptimistic
add

rst.ActiveConnection = CurrentProject.Connection

G LS
accessaceNOJUNK@valleyalley.co.uk
Remove the NOJUNK to use.

Please remember to give helpful posts the stars they deserve!
This makes the post more visible to others in need! :-D

 

[LittleSmudge]

Yes GKP the DAO code WILL work in A2k but that mean loading another ( unnecessary ) library and surely in a new development like this there is no good reason for writing the code from scratch in a legacy structure.

It's a good opportunity for Andrew to get going on the 'later' technology which is appropriate for this Application's capabilities.



G LS
accessaceNOJUNK@valleyalley.co.uk
Remove the NOJUNK to use.

Please remember to give helpful posts the stars they deserve!
This makes the post more visible to others in need! :-D

 

[AndrewCorkery]

Hi Guys,

Sorry to have to bother you again....

this time it falls over here:

tblValue = !Address Like &quot;*&quot; & AppValue(cnt) & &quot;*&quot;

for some reason it does not pick up the value in the address field, it say it is &quot;Null&quot;

thanks

andrew

 

[GKProgrammer]

Hi Andrew,

You should post all the code for this, it would probably be easier for us to help you that way.

Regards,
gkprogrammer

 

[AndrewCorkery]

Hi all,

here is all the code:

this time it falls over here:

tblValue = !Address Like &quot;*&quot; & AppValue(cnt) & &quot;*&quot;

for some reason it does not pick up the value in the address field, it say it is &quot;Null&quot;

Private Sub Command10_Click()

Dim rst As ADODB.Recordset
Set rst = New ADODB.Recordset
rst.CursorType = adOpenKeyset
rst.LockType = adLockOptimistic
rst.ActiveConnection = CurrentProject.Connection

Dim tblValue As String
Dim AppValue(1 To 4) As String 'change AppValue to number of different types
Dim cnt As Integer
Dim retValue As String

rst.Open &quot;SELECT * FROM tbl_TempHolding&quot; ' fill in your table name



AppValue(1) = &quot;Road&quot;
AppValue(2) = &quot;Street&quot;
AppValue(3) = &quot;Drive&quot;
AppValue(4) = &quot;Place&quot; 'Add the rest of your available values
cnt = 1

With rst
.MoveFirst
Do While 1 = 1
tblValue = !Address Like &quot;*&quot; & AppValue(cnt) & &quot;*&quot;
If tblValue = True Then
retValue = modStripChr.StripChr(!Address, AppValue(cnt))

!Address = retValue
!Type = AppValue(cnt)
.Update
.MoveNext
If .EOF = True Then Exit Do
cnt = 1
ElseIf cnt = 4 Then cnt = 4 'of different types
cnt = 1
.MoveNext
If .EOF = True Then Exit Do
Else
cnt = cnt + 1
End If
Loop
End With

Set rst = Nothing
dbs.Close

End Sub

Public Function StripChr(strValue As String, strChr As String) As String
Dim leng As Integer, strPos As Integer, chrPos As Integer

strPos = 1
leng = Len(strValue)
Do While 1 = 1
chrPos = InStr(strPos, strValue, strChr, Len(strChr))

If chrPos = 0 Then
StripChr = StripChr & Mid$(strValue, strPos, ((leng + 1) - strPos))
Exit Do
Else
StripChr = StripChr & Mid$(strValue, strPos, (chrPos - strPos))
End If
strPos = chrPos + Len(strChr)
Loop

End Function

 

[LittleSmudge]

Dim tblValue As String

WHAT ? Why are you using the table object prefix tbl to prefix a STRING - Then using it in the code as if it was type BOOLEAN ?



Replace this mess
tblValue = !Address Like &quot;*&quot; & AppValue(cnt) & &quot;*&quot;
If tblValue = True Then

With

If !Address Like "*" & AppValue(cnt) & "*" Then

& possibly you might even need

If !Address Like "'*" & AppValue(cnt) & "*'" Then

'ope-that-'elps.









G LS
accessaceNOJUNK@valleyalley.co.uk
Remove the NOJUNK to use.

Please remember to give helpful posts the stars they deserve!
This makes the post more visible to others in need! :-D

 

[AndrewCorkery]

Thanks GLS,

Got that working now one more hitch....

It gets stuck on this line:

retValue = modStripChr.StripChr(!Address, AppValue(cnt))

Object required Error...

Private Sub Command10_Click()

Dim rst As ADODB.Recordset
Set rst = New ADODB.Recordset
rst.CursorType = adOpenKeyset
rst.LockType = adLockOptimistic
rst.ActiveConnection = CurrentProject.Connection

Dim tblValue As String
Dim AppValue(1 To 4) As String 'change AppValue to number of different types
Dim cnt As Integer
Dim retValue As String

rst.Open &quot;SELECT * FROM tbl_TempHolding&quot; ' fill in your table name



AppValue(1) = &quot;Road&quot;
AppValue(2) = &quot;Street&quot;
AppValue(3) = &quot;Drive&quot;
AppValue(4) = &quot;Place&quot; 'Add the rest of your available values
cnt = 1

With rst
.MoveFirst
Do While 1 = 1
If !Address Like &quot;*&quot; & AppValue(cnt) & &quot;*&quot; Then
'If tblValue = True Then
retValue = modStripChr.StripChr(!Address, AppValue(cnt))

!Address = retValue
!Type = AppValue(cnt)
.Update
.MoveNext
If .EOF = True Then Exit Do
cnt = 1
ElseIf cnt = 4 Then cnt = 4 'of different types
cnt = 1
.MoveNext
If .EOF = True Then Exit Do
Else
cnt = cnt + 1
End If
Loop
End With

Set rst = Nothing
dbs.Close

End Sub

Public Function StripChr(strValue As String, strChr As String) As String
Dim leng As Integer, strPos As Integer, chrPos As Integer

strPos = 1
leng = Len(strValue)
Do While 1 = 1
chrPos = InStr(strPos, strValue, strChr, Len(strChr))

If chrPos = 0 Then
StripChr = StripChr & Mid$(strValue, strPos, ((leng + 1) - strPos))
Exit Do
Else
StripChr = StripChr & Mid$(strValue, strPos, (chrPos - strPos))
End If
strPos = chrPos + Len(strChr)
Loop

End Function

 

[LittleSmudge]

Try This


If !Address Like &quot;*&quot; & AppValue(cnt) & &quot;*&quot; Then
tblValue = !Address
retValue = modStripChr.StripChr(tblValue, AppValue(cnt))




. G LS
accessaceNOJUNK@valleyalley.co.uk
Remove the NOJUNK to use.

Please remember to give helpful posts the stars they deserve!
This makes the post more visible to others in need! :-D

 

[AndrewCorkery]

come up with the same error:
&quot;run time error 424
object required&quot;

on line:

retValue = modStripChr.StripChr(tblValue, AppValue(cnt))

it looks like it is not carrying out the function?

 

[LittleSmudge]

So lets see what the thing is getting

If !Address Like &quot;*&quot; & AppValue(cnt) & &quot;*&quot; Then
tblValue = !Address
MsgBox !Address, , AppValue(cnt)
retValue = modStripChr.StripChr(!Address, AppValue(cnt))

( WHY are you fully referencing the StripChr procedure ?
Unless you have two procedures called StripChr & both are 'in scope' then the &quot;modStripChr.&quot; is unnecessary )



If the above message box doesn't reveil anything useful then put a Break Point somewhere early on in the StripChr proc to see if it is actualy inside the proc that the problem is arising.

Then let me know what you get.







G LS
accessaceNOJUNK@valleyalley.co.uk
Remove the NOJUNK to use.

Please remember to give helpful posts the stars they deserve!
This makes the post more visible to others in need! :-D

 

[AndrewCorkery]

finally got it to work thanks GLS!!

 

[MichaelRed]

I TRIED to simply ignore it. But, LittleSmudge just HAD to raise the issue &quot; ... surely in a new development like this there is no good reason for writing the code from scratch in a legacy structure ... &quot;[/]

Some of the &quot;CODE&quot; is so RETRO I could not (under these conditions) let it go unremarked.

Building infinite loops and then depending on a counter of an array to trigger an exit?

Another 'infinite' loop (for a recordset) and then the addition of a logical check to determine that the recordset has been exhausted?

There are others (even ubtouched ones!) but this looks like an attempt at job security via FUD and confusion thrown in for BAD measure!

At least the &quot;Main&quot; procedure is slightly re-written ...

Public Sub basTrimAdrTyp()

    Dim rst As ADODB.Recordset
    Set rst = New ADODB.Recordset
    rst.CursorType = adOpenKeyset
    rst.LockType = adLockOptimistic
    rst.ActiveConnection = CurrentProject.Connection

    Dim AppValue(1 To 4) As String 'change AppValue to number of different types
    Dim retValue As String
    Dim Idx As Long
    
    rst.Open "SELECT * FROM tblAddr"    'fill in your table name

    AppValue(1) = "Road"
    AppValue(2) = "Street"
    AppValue(3) = "Drive"
    AppValue(4) = "Place"               'Add the rest of your available values
    
    With rst
        Do While Not .EOF
            Idx = 1
            Do While Idx <= UBound(AppValue)
                If (!Addr1 Like &quot;*&quot; & AppValue(Idx) & &quot;*&quot;) Then
                    retValue = StripChr(!Addr1, AppValue(Idx))
                    !Addr1 = retValue
                    !AdrType = AppValue(Idx)
                    .Update
                End If
                Idx = Idx + 1
            Loop
            .MoveNext
        Loop
    End With
    
    Set rst = Nothing
    
End Sub

MichaelRed
m.red@att.net

There is never time to do it right but there is always time to do it over