sqlplus
user: sys@gprodd as sysdba
password:
Friday, August 22, 2008
Friday, August 15, 2008
oracle update fields using joining other table
The short URL for this FAQ is http://tinyurl.com/2vphxg
Here are four examples of updating multiple columns with a single statement. The DML options are UPDATE, 10gr2 MERGE, 9i MERGE. Another option, if you can join on a database-enforced unique constraint (for example, a primary key), is "updating a join".
Set up the example: create table tgt ( id number /*primary key*/, x number, y number )
/
insert into tgt ( id, x, y )
select level, level, level from dual connect by level < 4
/
create table src ( id number /*primary key*/, x number, y number )
/
insert into src ( id, x, y )
select level+1, level*5, level*5 from dual connect by level < 3
/
commit
/
select * from src;
ID X Y
---------- ---------- ----------
2 5 5
3 10 10
select * from tgt;
ID X Y
---------- ---------- ----------
1 1 1
2 2 2
3 3 3
The first example is an UPDATE statment: UPDATE tgt
SET ( tgt.x, tgt.y ) =
( SELECT src.x, src.y
FROM src
WHERE src.id = tgt.id
)
WHERE EXISTS
( SELECT src.x, src.y
FROM src
WHERE src.id = tgt.id
)
/
2 rows updated.
select * from tgt;
ID X Y
---------- ---------- ----------
1 1 1
2 5 5
3 10 10
The second example uses a 10gR2 MERGE statement: MERGE into tgt /* Oracle 10gR2 doesn't require WHEN NOT MATCHED */
USING src
ON ( src.id = tgt.id )
WHEN MATCHED THEN UPDATE SET
tgt.x = src.x
, tgt.y = src.y
/
2 rows updated.
select * from tgt;
ID X Y
---------- ---------- ----------
1 1 1
2 5 5
3 10 10
The third example using a 9i MERGE, which requires (even if it doesn't use) a WHEN NOT MATCHED clause: MERGE into tgt /* Oracle 9i requires WHEN NOT MATCHED */
USING
( SELECT src.x, src.y, src.id
FROM src INNER JOIN tgt
ON ( src.id = tgt.id )
) src
ON ( src.id = tgt.id )
WHEN MATCHED THEN UPDATE SET
tgt.x = src.x
, tgt.y = src.y
WHEN NOT MATCHED -- NEVER INVOKED
THEN INSERT -- NEVER INVOKED
( tgt.id ) -- NEVER INVOKED
VALUES -- NEVER INVOKED
( src.id ) -- NEVER INVOKED
/
2 rows updated.
select * from tgt;
ID X Y
---------- ---------- ----------
1 1 1
2 5 5
3 10 10
The previous examples succeeded despite a lack of database-enforced uniqueness constraints. SRC.ID had to be unique in practice, otherwise Oracle will throw the error: ORA-30926: unable to get a stable set of rows in the source tables
If there are multiple subquery results per updated row, the DBMS doesn't know which source row to use for the update. However, uniqueness didn't have to be declared in DDL to the DBMS.
The fourth example, "updating a join", requires database-enforced uniqueness on SRC.ID. In other words, SRC must be key preserved not just in practice, but enforced design. Updating a join doesn't check for a "stable set of rows" on-the-fly, it demands a "stable set of rows" be database-enforced before hand.
Here the UPDATE is without a unique constraint (like the previous three examples). It fails: UPDATE
( SELECT src.x src_x, src.y src_y
, tgt.x tgt_x, tgt.y tgt_y
FROM src INNER JOIN tgt
ON ( src.id = tgt.id )
)
SET tgt_x = src_x
, tgt_y = src_y
/
SET tgt_x = src_x
*
ERROR at line 7:
ORA-01779: cannot modify a column which maps to a non key-preserved table
So "key preserve" the join by putting a primary key on src.ID. alter table src add primary key (id)
/
Table altered.
Then updating a join will succeed: UPDATE
( SELECT src.x src_x, src.y src_y
, tgt.x tgt_x, tgt.y tgt_y
FROM src INNER JOIN tgt
ON ( src.id = tgt.id )
)
SET tgt_x = src_x
, tgt_y = src_y
/
2 rows updated.
select * from tgt;
ID X Y
---------- ---------- ----------
1 1 1
2 5 5
3 10 10
Note that the use of column aliases. This ensured unique column
Here are four examples of updating multiple columns with a single statement. The DML options are UPDATE, 10gr2 MERGE, 9i MERGE. Another option, if you can join on a database-enforced unique constraint (for example, a primary key), is "updating a join".
Set up the example: create table tgt ( id number /*primary key*/, x number, y number )
/
insert into tgt ( id, x, y )
select level, level, level from dual connect by level < 4
/
create table src ( id number /*primary key*/, x number, y number )
/
insert into src ( id, x, y )
select level+1, level*5, level*5 from dual connect by level < 3
/
commit
/
select * from src;
ID X Y
---------- ---------- ----------
2 5 5
3 10 10
select * from tgt;
ID X Y
---------- ---------- ----------
1 1 1
2 2 2
3 3 3
The first example is an UPDATE statment: UPDATE tgt
SET ( tgt.x, tgt.y ) =
( SELECT src.x, src.y
FROM src
WHERE src.id = tgt.id
)
WHERE EXISTS
( SELECT src.x, src.y
FROM src
WHERE src.id = tgt.id
)
/
2 rows updated.
select * from tgt;
ID X Y
---------- ---------- ----------
1 1 1
2 5 5
3 10 10
The second example uses a 10gR2 MERGE statement: MERGE into tgt /* Oracle 10gR2 doesn't require WHEN NOT MATCHED */
USING src
ON ( src.id = tgt.id )
WHEN MATCHED THEN UPDATE SET
tgt.x = src.x
, tgt.y = src.y
/
2 rows updated.
select * from tgt;
ID X Y
---------- ---------- ----------
1 1 1
2 5 5
3 10 10
The third example using a 9i MERGE, which requires (even if it doesn't use) a WHEN NOT MATCHED clause: MERGE into tgt /* Oracle 9i requires WHEN NOT MATCHED */
USING
( SELECT src.x, src.y, src.id
FROM src INNER JOIN tgt
ON ( src.id = tgt.id )
) src
ON ( src.id = tgt.id )
WHEN MATCHED THEN UPDATE SET
tgt.x = src.x
, tgt.y = src.y
WHEN NOT MATCHED -- NEVER INVOKED
THEN INSERT -- NEVER INVOKED
( tgt.id ) -- NEVER INVOKED
VALUES -- NEVER INVOKED
( src.id ) -- NEVER INVOKED
/
2 rows updated.
select * from tgt;
ID X Y
---------- ---------- ----------
1 1 1
2 5 5
3 10 10
The previous examples succeeded despite a lack of database-enforced uniqueness constraints. SRC.ID had to be unique in practice, otherwise Oracle will throw the error: ORA-30926: unable to get a stable set of rows in the source tables
If there are multiple subquery results per updated row, the DBMS doesn't know which source row to use for the update. However, uniqueness didn't have to be declared in DDL to the DBMS.
The fourth example, "updating a join", requires database-enforced uniqueness on SRC.ID. In other words, SRC must be key preserved not just in practice, but enforced design. Updating a join doesn't check for a "stable set of rows" on-the-fly, it demands a "stable set of rows" be database-enforced before hand.
Here the UPDATE is without a unique constraint (like the previous three examples). It fails: UPDATE
( SELECT src.x src_x, src.y src_y
, tgt.x tgt_x, tgt.y tgt_y
FROM src INNER JOIN tgt
ON ( src.id = tgt.id )
)
SET tgt_x = src_x
, tgt_y = src_y
/
SET tgt_x = src_x
*
ERROR at line 7:
ORA-01779: cannot modify a column which maps to a non key-preserved table
So "key preserve" the join by putting a primary key on src.ID. alter table src add primary key (id)
/
Table altered.
Then updating a join will succeed: UPDATE
( SELECT src.x src_x, src.y src_y
, tgt.x tgt_x, tgt.y tgt_y
FROM src INNER JOIN tgt
ON ( src.id = tgt.id )
)
SET tgt_x = src_x
, tgt_y = src_y
/
2 rows updated.
select * from tgt;
ID X Y
---------- ---------- ----------
1 1 1
2 5 5
3 10 10
Note that the use of column aliases. This ensured unique column
Thursday, August 7, 2008
VBA geocoding script
'this code can be expanded to use google geocode
'this code can be expanded to provide web service
Const LATITUDECOL = 1 ' column to put longitude into
Const LONGITUDECOL = 2 ' column to put latitude into
Const PRECISIONCOL = 3
Const STREETCOL = 4 ' column to find street
Const CITYCOL = 5 ' column to find city
Const STATECOL = 6 ' column to find state
Const ZIPCOL = 7 ' column to find zipcode data
Const stdAddr = 8
Const FIRSTDATAROW = 2 ' rows above this row don't contain address data
' holds cache of strings submitted to geocoder during this session along with results
' to ensure that duplicate strings aren't submitted
' TODO: make this cache persist across sessions
Dim geocodeResults As New Collection
' GEOCODING is done using the following layers
'
'geocodeSelectedRows
'(for each row call geocodeRow)
'
' geocodeRow(r)
' (check that row is geocodable, pass to geocode, parse results)
'
' geocode(street,city,state,zip)
' (clean all variables, pass url to geocoderAddressLookup,
' if no result then try different permuatations of address)
'
' geocoderAddressLookup
' (query geocoder.us, return result, marshal results)
'
' submit selected rows to the geocoder
Sub geocodeSelectedRows()
Dim r
If [GeocoderToUse] = "Yahoo" Then
If [yahooid] <> "" Then
For Each r In Selection.rows()
If r.Row() >= FIRSTDATAROW Then geocodeRow (r.Row())
Next r
Application.StatusBar = False
Else:
MsgBox "Please enter a Yahoo Id for geocoding"
End If
Else:
If (trim(CStr([geocoderPassword])) <> "" And trim(CStr([geocoderPassword])) <> "") Then
For Each r In Selection.rows()
If r.Row() >= FIRSTDATAROW Then geocodeRow (r.Row())
Next r
Application.StatusBar = False
Else
MsgBox "Please enter a username and password at geocoder.us on the Settings and Instructions page."
End If
End If
End Sub
Sub geocodeAllRows()
Dim r As Integer
If [GeocoderToUse] = "Yahoo" Then
If [yahooid] <> "" Then
For r = FIRSTDATAROW To LastDataRow()
geocodeRow (r)
Next r
Application.StatusBar = False
Else:
MsgBox "Please enter a Yahoo Id for geocoding"
End If
Else:
If (trim(CStr([geocoderPassword])) <> "" And trim(CStr([geocoderPassword])) <> "") Then
For r = FIRSTDATAROW To LastDataRow()
geocodeRow (r)
Next r
Application.StatusBar = False
Else
MsgBox "Please enter a username and password at geocoder.us on the Settings and Instructions page."
End If
End If
End Sub
' geocode a single row of data
Sub geocodeRow(r As Integer)
Dim addr As String
Dim resultstr As String
Dim resultarray
Application.StatusBar = "Geocoding row: " & r
' requires street address and a blank latitude to continue
' can't geocode if no address data
' nonblank latitude means we've already geocoded this row
If Cells(r, STREETCOL) & Cells(r, CITYCOL) & Cells(r, STATECOL) & Cells(r, ZIPCOL) <> "" And Cells(r, LATITUDECOL) = "" Then
' pass the street, city, state, and zip to the function geocode
' geocode returns a string containing the results in comma delimited format
' this is crude, but works
' CStr casts (converts) a value to a string
resultstr = geocode(CStr(Cells(r, STREETCOL)), CStr(Cells(r, CITYCOL)), CStr(Cells(r, STATECOL)), CStr(Cells(r, ZIPCOL)))
' parse the results
resultarray = Split(resultstr, ",")
If resultarray(0) = "" Then resultarray(0) = "not found"
If resultarray(1) = "" Then resultarray(1) = "not found"
If resultarray(2) = "" And resultarray(0) = "not found" Then resultarray(2) = "not found"
'If resultarray(2) = "" Then resultarray(2) = "address"
' store the results
Cells(r, LATITUDECOL) = resultarray(0)
Cells(r, LONGITUDECOL) = resultarray(1)
Cells(r, PRECISIONCOL) = resultarray(2)
Cells(r, stdAddr) = resultarray(3)
End If
End Sub
' normalization function for street addresses
' removes apartment numbers, suite numbers that cause problems for geocoder.us
Function geocodeCleanStreet(street As String) As String
street = LCase(street)
street = trimstr(street, "#")
street = trimstr(street, " apartment ")
street = trimstr(street, " apt ")
street = trimstr(street, " apt ")
street = trimstr(street, " lot ")
street = trimstr(street, " unit ")
street = trimstr(street, " suite ")
street = trimstr(street, " ste ")
street = trimstr(street, " trlr ")
geocodeCleanStreet = street
End Function
' removed invalid characters from address
Function geocodeNormalizeAddress(addr As String) As String
' normalize address and prepare to pass to geocoder.us
addr = LCase(addr)
addr = Replace(addr, "-", " ")
addr = Replace(addr, ".", " ")
addr = Replace(addr, " ", " ")
addr = Replace(addr, " ", " ")
addr = Replace(addr, " ", " ")
addr = Replace(addr, " ", "+")
geocodeNormalizeAddress = addr
End Function
Function geocodeCleanZip(zip As String) As String
' normalize zipcode to 5 digits or 9 digits
zip = RegExValidate(zip, "[0-9]")
If Len(zip) = 4 Or Len(zip) = 5 Then
geocodeCleanZip = Application.WorksheetFunction.Text(zip, "00000")
ElseIf Len(zip) = 8 Or Len(zip) = 9 Then
zip4 = Right(zip, 4)
zip5 = Left(zip, Len(zip) - 4)
geocodeCleanZip = Application.WorksheetFunction.Text(zip5, "00000") & "-" & Application.WorksheetFunction.Text(zip4, "0000")
Else:
geocodeCleanZip = ""
End If
End Function
' remove everything following the start of the string trim
Function trimstr(basestr As String, trim As String) As String
If InStr(basestr, trim) > 0 Then
trimstr = Left(basestr, InStr(basestr, trim) - 1)
Else
trimstr = basestr
End If
End Function
' remove everything following the end of the string trim
Function trimstrafter(basestr As String, trim As String) As String
If InStr(basestr, trim) > 0 Then
trimstrafter = Left(basestr, InStr(basestr, trim) + Len(trim) - 1)
Else
trimstrafter = basestr
End If
End Function
Function geocode(street As String, city As String, state As String, zip As String) As String
' clean up the address and call geocodeAddressLookup
Dim result As String
Dim addr As String
street = geocodeCleanStreet(street)
city = RegExValidate(LCase(city), "[a-z ]")
state = RegExValidate(UCase(state), "[A-Z ]")
zip = geocodeCleanZip(zip)
' if the street address is a PO box then we won't be able to geocode
' if zip not blank then try looking up street and zip
' if this fails, try looking up street, city, state
' if this fails, try fixing up the street
' if street has changed after fixup, try looking up street and zip
' if this fails, try looking up street, city, state
If [GeocoderToUse] = "Yahoo" Then
result = yahooAddressLookup(street, city, state, zip)
Else:
If Left(street, 5) = "xxxxx" Or _
Left(street, 6) = "po box" Or _
Left(street, 7) = "post of" Or _
Left(street, 7) = "p o box" Or _
Left(street, 7) = "city of" Then
result = ",,"
Else:
If zip <> "" Then
result = geocoderAddressLookup(geocodeNormalizeAddress(street & ", " & zip))
Else
result = ",,"
End If
If result = ",," Then
If city <> "" And state <> "" Then
result = geocoderAddressLookup(geocodeNormalizeAddress(street & ", " & zip))
Else
result = ",,"
End If
If result = ",," And street <> "" Then
oldstreet = street
' try to clean up street
street = Replace(street, " th ", "th ")
street = Replace(street, " rd ", "rd ")
street = trimstrafter(street, "st")
street = trimstrafter(street, "dr")
street = trimstrafter(street, "rd")
street = trimstrafter(street, "road")
street = trimstrafter(street, "dr")
street = trimstrafter(street, "lane")
street = trimstrafter(street, "ln")
street = trimstrafter(street, "ave")
street = trimstrafter(street, "blvd")
street = trimstrafter(street, "boulevard")
street = trimstrafter(street, "pl")
If street <> oldstreet Then
If zip <> "" Then
result = geocoderAddressLookup(geocodeNormalizeAddress(street & ", " & zip))
Else
result = ",,"
End If
If result = ",," Then
result = geocoderAddressLookup(geocodeNormalizeAddress(street & ", " & zip))
Else
result = ",,"
End If
End If
End If
End If
End If
End If
geocode = result
End Function
Function yahooAddressLookup(street As String, city As String, state As String, zip As String) As String
' perform RESTian lookup on Yahoo
Dim marshalledResult As String
Dim yahoo As String
Dim response As String
Dim result As String
' marshal the results of this very time consuming function
' see if we've already looked up this address
' turn error handling off
On Error Resume Next
' lookup the result in the collection
' an error will be raised if the value is not found
marshalledResult = geocodeResults(addr)
If marshalledResult <> "" Then
' if a value is found then return the result
geocodeAddressLookup = marshalledResult
Exit Function
End If
' turn error handling back on
On Error GoTo 0
Application.StatusBar = "Looking for " & street & ", " & city & ", " & state & " " & zip
yahoo = trim(CStr([yahooid]))
street = trim(street)
city = trim(city)
state = trim(state)
zip = trim(zip)
URL = "http://api.local.yahoo.com/MapsService/V1/geocode?appid=" & yahoo & "&street=" & street & "&city=" & city & "&state=" & state & "&zip=" & zip
'Create Http object
If IsEmpty(http) Then Set http = CreateObject("WinHttp.WinHttpRequest.5.1")
'Send request To URL
http.Open "GET", URL
http.send
'Get response data As a string
response = http.responseText
' capture the latitude by regex matching the values in the tags and
lat = RegExMatch(response, "([\.\-0-9]+) ")
lng = RegExMatch(response, "([\.\-0-9]+) ")
precision = RegExMatch(response, "precision=""([a-z0-9+]+)""")
addr = RegExMatch(response, "[0-9+]+ (.*)")
' return a comma delimited string
' if values not found, this will return ","
yahooAddressLookup = lat & "," & lng & "," & precision & "," & addr
If [BeepOn] Then Beep
' store the result in the cache collection
'
' turn off error handling with "On Error Resume Next"
' an error will be raised if you try to store to an address already in the cache
' we can ignore this error
On Error Resume Next
' store the result
geocodeResults(addr) = lat & "," & lng
End Function
Function geocoderAddressLookup(addr As String) As String
' perform RESTian lookup on geocoder.us
Dim marshalledResult As String
Dim usernm As String
Dim passwd As String
Dim response As String
Dim result As String
' marshal the results of this very time consuming function
' see if we've already looked up this address
' turn error handling off
On Error Resume Next
' lookup the result in the collection
' an error will be raised if the value is not found
marshalledResult = geocodeResults(addr)
If marshalledResult <> "" Then
' if a value is found then return the result
geocodeAddressLookup = marshalledResult
Exit Function
End If
' turn error handling back on
On Error GoTo 0
Application.StatusBar = "Looking for " & addr
usernm = trim(CStr([geocoderUsername]))
passwd = trim(CStr([geocoderPassword]))
URL = "http://geocoder.us/member/service/rest/geocode?address=" & addr
'Create Http object
If IsEmpty(http) Then Set http = CreateObject("WinHttp.WinHttpRequest.5.1")
'Send request To URL
http.Open "GET", URL
http.setcredentials usernm, passwd, 0
http.send
'Get response data As a string
response = http.responseText
' capture the latitude by regex matching the values in the tags and
lat = RegExMatch(response, "(.+) ")
lng = RegExMatch(response, "(.+) ")
' return a comma delimtied string
' if values not found, this will return ","
geocoderAddressLookup = lat & "," & lng & ","
Beep
' store the result in the cache collection
'
' turn off error handling with "On Error Resume Next"
' an error will be raised if you try to store to an address already in the cache
' we can ignore this error
On Error Resume Next
' store the result
geocodeResults(addr) = lat & "," & lng
End Function
' wraps string with a tag
Function tag(xmltag As String, val As String) As String
tag = "<" & xmltag & ">" & val & "" & vbCrLf
End Function
' basic distance function for latitude/longitude
Public Function latLongDistance(lat1 As Double, long1 As Double, lat2 As Double, long2 As Double) As Double
Dim x As Double
Dim y As Double
x = 69.1 * (lat2 - lat1)
y = 69.1 * (long2 - long1) * Cos(lat1 / 57.3)
latLongDistance = (x * x + y * y) ^ 0.5
End Function
Private Function max(a, b):
If a > b Then
max = a
Else
max = b
End If
End Function
' locate the last row containing address data
Function LastDataRow() As Integer
Dim r As Integer
activecelladdr = ActiveCell.Address
Range("d65536").End(xlUp).Select
r = ActiveCell.Row()
Range("e65536").End(xlUp).Select
r = max(r, ActiveCell.Row())
Range("f65536").End(xlUp).Select
r = max(r, ActiveCell.Row())
Range("g65536").End(xlUp).Select
r = max(r, ActiveCell.Row())
Range(activecelladdr).Select
LastDataRow = r
End Function
Sub MacrosWorking()
MsgBox "Macros are enabled."
End Sub
'this code can be expanded to provide web service
Const LATITUDECOL = 1 ' column to put longitude into
Const LONGITUDECOL = 2 ' column to put latitude into
Const PRECISIONCOL = 3
Const STREETCOL = 4 ' column to find street
Const CITYCOL = 5 ' column to find city
Const STATECOL = 6 ' column to find state
Const ZIPCOL = 7 ' column to find zipcode data
Const stdAddr = 8
Const FIRSTDATAROW = 2 ' rows above this row don't contain address data
' holds cache of strings submitted to geocoder during this session along with results
' to ensure that duplicate strings aren't submitted
' TODO: make this cache persist across sessions
Dim geocodeResults As New Collection
' GEOCODING is done using the following layers
'
'geocodeSelectedRows
'(for each row call geocodeRow)
'
' geocodeRow(r)
' (check that row is geocodable, pass to geocode, parse results)
'
' geocode(street,city,state,zip)
' (clean all variables, pass url to geocoderAddressLookup,
' if no result then try different permuatations of address)
'
' geocoderAddressLookup
' (query geocoder.us, return result, marshal results)
'
' submit selected rows to the geocoder
Sub geocodeSelectedRows()
Dim r
If [GeocoderToUse] = "Yahoo" Then
If [yahooid] <> "" Then
For Each r In Selection.rows()
If r.Row() >= FIRSTDATAROW Then geocodeRow (r.Row())
Next r
Application.StatusBar = False
Else:
MsgBox "Please enter a Yahoo Id for geocoding"
End If
Else:
If (trim(CStr([geocoderPassword])) <> "" And trim(CStr([geocoderPassword])) <> "") Then
For Each r In Selection.rows()
If r.Row() >= FIRSTDATAROW Then geocodeRow (r.Row())
Next r
Application.StatusBar = False
Else
MsgBox "Please enter a username and password at geocoder.us on the Settings and Instructions page."
End If
End If
End Sub
Sub geocodeAllRows()
Dim r As Integer
If [GeocoderToUse] = "Yahoo" Then
If [yahooid] <> "" Then
For r = FIRSTDATAROW To LastDataRow()
geocodeRow (r)
Next r
Application.StatusBar = False
Else:
MsgBox "Please enter a Yahoo Id for geocoding"
End If
Else:
If (trim(CStr([geocoderPassword])) <> "" And trim(CStr([geocoderPassword])) <> "") Then
For r = FIRSTDATAROW To LastDataRow()
geocodeRow (r)
Next r
Application.StatusBar = False
Else
MsgBox "Please enter a username and password at geocoder.us on the Settings and Instructions page."
End If
End If
End Sub
' geocode a single row of data
Sub geocodeRow(r As Integer)
Dim addr As String
Dim resultstr As String
Dim resultarray
Application.StatusBar = "Geocoding row: " & r
' requires street address and a blank latitude to continue
' can't geocode if no address data
' nonblank latitude means we've already geocoded this row
If Cells(r, STREETCOL) & Cells(r, CITYCOL) & Cells(r, STATECOL) & Cells(r, ZIPCOL) <> "" And Cells(r, LATITUDECOL) = "" Then
' pass the street, city, state, and zip to the function geocode
' geocode returns a string containing the results in comma delimited format
' this is crude, but works
' CStr casts (converts) a value to a string
resultstr = geocode(CStr(Cells(r, STREETCOL)), CStr(Cells(r, CITYCOL)), CStr(Cells(r, STATECOL)), CStr(Cells(r, ZIPCOL)))
' parse the results
resultarray = Split(resultstr, ",")
If resultarray(0) = "" Then resultarray(0) = "not found"
If resultarray(1) = "" Then resultarray(1) = "not found"
If resultarray(2) = "" And resultarray(0) = "not found" Then resultarray(2) = "not found"
'If resultarray(2) = "" Then resultarray(2) = "address"
' store the results
Cells(r, LATITUDECOL) = resultarray(0)
Cells(r, LONGITUDECOL) = resultarray(1)
Cells(r, PRECISIONCOL) = resultarray(2)
Cells(r, stdAddr) = resultarray(3)
End If
End Sub
' normalization function for street addresses
' removes apartment numbers, suite numbers that cause problems for geocoder.us
Function geocodeCleanStreet(street As String) As String
street = LCase(street)
street = trimstr(street, "#")
street = trimstr(street, " apartment ")
street = trimstr(street, " apt ")
street = trimstr(street, " apt ")
street = trimstr(street, " lot ")
street = trimstr(street, " unit ")
street = trimstr(street, " suite ")
street = trimstr(street, " ste ")
street = trimstr(street, " trlr ")
geocodeCleanStreet = street
End Function
' removed invalid characters from address
Function geocodeNormalizeAddress(addr As String) As String
' normalize address and prepare to pass to geocoder.us
addr = LCase(addr)
addr = Replace(addr, "-", " ")
addr = Replace(addr, ".", " ")
addr = Replace(addr, " ", " ")
addr = Replace(addr, " ", " ")
addr = Replace(addr, " ", " ")
addr = Replace(addr, " ", "+")
geocodeNormalizeAddress = addr
End Function
Function geocodeCleanZip(zip As String) As String
' normalize zipcode to 5 digits or 9 digits
zip = RegExValidate(zip, "[0-9]")
If Len(zip) = 4 Or Len(zip) = 5 Then
geocodeCleanZip = Application.WorksheetFunction.Text(zip, "00000")
ElseIf Len(zip) = 8 Or Len(zip) = 9 Then
zip4 = Right(zip, 4)
zip5 = Left(zip, Len(zip) - 4)
geocodeCleanZip = Application.WorksheetFunction.Text(zip5, "00000") & "-" & Application.WorksheetFunction.Text(zip4, "0000")
Else:
geocodeCleanZip = ""
End If
End Function
' remove everything following the start of the string trim
Function trimstr(basestr As String, trim As String) As String
If InStr(basestr, trim) > 0 Then
trimstr = Left(basestr, InStr(basestr, trim) - 1)
Else
trimstr = basestr
End If
End Function
' remove everything following the end of the string trim
Function trimstrafter(basestr As String, trim As String) As String
If InStr(basestr, trim) > 0 Then
trimstrafter = Left(basestr, InStr(basestr, trim) + Len(trim) - 1)
Else
trimstrafter = basestr
End If
End Function
Function geocode(street As String, city As String, state As String, zip As String) As String
' clean up the address and call geocodeAddressLookup
Dim result As String
Dim addr As String
street = geocodeCleanStreet(street)
city = RegExValidate(LCase(city), "[a-z ]")
state = RegExValidate(UCase(state), "[A-Z ]")
zip = geocodeCleanZip(zip)
' if the street address is a PO box then we won't be able to geocode
' if zip not blank then try looking up street and zip
' if this fails, try looking up street, city, state
' if this fails, try fixing up the street
' if street has changed after fixup, try looking up street and zip
' if this fails, try looking up street, city, state
If [GeocoderToUse] = "Yahoo" Then
result = yahooAddressLookup(street, city, state, zip)
Else:
If Left(street, 5) = "xxxxx" Or _
Left(street, 6) = "po box" Or _
Left(street, 7) = "post of" Or _
Left(street, 7) = "p o box" Or _
Left(street, 7) = "city of" Then
result = ",,"
Else:
If zip <> "" Then
result = geocoderAddressLookup(geocodeNormalizeAddress(street & ", " & zip))
Else
result = ",,"
End If
If result = ",," Then
If city <> "" And state <> "" Then
result = geocoderAddressLookup(geocodeNormalizeAddress(street & ", " & zip))
Else
result = ",,"
End If
If result = ",," And street <> "" Then
oldstreet = street
' try to clean up street
street = Replace(street, " th ", "th ")
street = Replace(street, " rd ", "rd ")
street = trimstrafter(street, "st")
street = trimstrafter(street, "dr")
street = trimstrafter(street, "rd")
street = trimstrafter(street, "road")
street = trimstrafter(street, "dr")
street = trimstrafter(street, "lane")
street = trimstrafter(street, "ln")
street = trimstrafter(street, "ave")
street = trimstrafter(street, "blvd")
street = trimstrafter(street, "boulevard")
street = trimstrafter(street, "pl")
If street <> oldstreet Then
If zip <> "" Then
result = geocoderAddressLookup(geocodeNormalizeAddress(street & ", " & zip))
Else
result = ",,"
End If
If result = ",," Then
result = geocoderAddressLookup(geocodeNormalizeAddress(street & ", " & zip))
Else
result = ",,"
End If
End If
End If
End If
End If
End If
geocode = result
End Function
Function yahooAddressLookup(street As String, city As String, state As String, zip As String) As String
' perform RESTian lookup on Yahoo
Dim marshalledResult As String
Dim yahoo As String
Dim response As String
Dim result As String
' marshal the results of this very time consuming function
' see if we've already looked up this address
' turn error handling off
On Error Resume Next
' lookup the result in the collection
' an error will be raised if the value is not found
marshalledResult = geocodeResults(addr)
If marshalledResult <> "" Then
' if a value is found then return the result
geocodeAddressLookup = marshalledResult
Exit Function
End If
' turn error handling back on
On Error GoTo 0
Application.StatusBar = "Looking for " & street & ", " & city & ", " & state & " " & zip
yahoo = trim(CStr([yahooid]))
street = trim(street)
city = trim(city)
state = trim(state)
zip = trim(zip)
URL = "http://api.local.yahoo.com/MapsService/V1/geocode?appid=" & yahoo & "&street=" & street & "&city=" & city & "&state=" & state & "&zip=" & zip
'Create Http object
If IsEmpty(http) Then Set http = CreateObject("WinHttp.WinHttpRequest.5.1")
'Send request To URL
http.Open "GET", URL
http.send
'Get response data As a string
response = http.responseText
' capture the latitude by regex matching the values in the tags
lat = RegExMatch(response, "
lng = RegExMatch(response, "
precision = RegExMatch(response, "precision=""([a-z0-9+]+)""")
addr = RegExMatch(response, "[0-9+]+ (.*)")
' return a comma delimited string
' if values not found, this will return ","
yahooAddressLookup = lat & "," & lng & "," & precision & "," & addr
If [BeepOn] Then Beep
' store the result in the cache collection
'
' turn off error handling with "On Error Resume Next"
' an error will be raised if you try to store to an address already in the cache
' we can ignore this error
On Error Resume Next
' store the result
geocodeResults(addr) = lat & "," & lng
End Function
Function geocoderAddressLookup(addr As String) As String
' perform RESTian lookup on geocoder.us
Dim marshalledResult As String
Dim usernm As String
Dim passwd As String
Dim response As String
Dim result As String
' marshal the results of this very time consuming function
' see if we've already looked up this address
' turn error handling off
On Error Resume Next
' lookup the result in the collection
' an error will be raised if the value is not found
marshalledResult = geocodeResults(addr)
If marshalledResult <> "" Then
' if a value is found then return the result
geocodeAddressLookup = marshalledResult
Exit Function
End If
' turn error handling back on
On Error GoTo 0
Application.StatusBar = "Looking for " & addr
usernm = trim(CStr([geocoderUsername]))
passwd = trim(CStr([geocoderPassword]))
URL = "http://geocoder.us/member/service/rest/geocode?address=" & addr
'Create Http object
If IsEmpty(http) Then Set http = CreateObject("WinHttp.WinHttpRequest.5.1")
'Send request To URL
http.Open "GET", URL
http.setcredentials usernm, passwd, 0
http.send
'Get response data As a string
response = http.responseText
' capture the latitude by regex matching the values in the tags
lat = RegExMatch(response, "
lng = RegExMatch(response, "
' return a comma delimtied string
' if values not found, this will return ","
geocoderAddressLookup = lat & "," & lng & ","
Beep
' store the result in the cache collection
'
' turn off error handling with "On Error Resume Next"
' an error will be raised if you try to store to an address already in the cache
' we can ignore this error
On Error Resume Next
' store the result
geocodeResults(addr) = lat & "," & lng
End Function
' wraps string with a tag
Function tag(xmltag As String, val As String) As String
tag = "<" & xmltag & ">" & val & "" & vbCrLf
End Function
' basic distance function for latitude/longitude
Public Function latLongDistance(lat1 As Double, long1 As Double, lat2 As Double, long2 As Double) As Double
Dim x As Double
Dim y As Double
x = 69.1 * (lat2 - lat1)
y = 69.1 * (long2 - long1) * Cos(lat1 / 57.3)
latLongDistance = (x * x + y * y) ^ 0.5
End Function
Private Function max(a, b):
If a > b Then
max = a
Else
max = b
End If
End Function
' locate the last row containing address data
Function LastDataRow() As Integer
Dim r As Integer
activecelladdr = ActiveCell.Address
Range("d65536").End(xlUp).Select
r = ActiveCell.Row()
Range("e65536").End(xlUp).Select
r = max(r, ActiveCell.Row())
Range("f65536").End(xlUp).Select
r = max(r, ActiveCell.Row())
Range("g65536").End(xlUp).Select
r = max(r, ActiveCell.Row())
Range(activecelladdr).Select
LastDataRow = r
End Function
Sub MacrosWorking()
MsgBox "Macros are enabled."
End Sub
Subscribe to:
Posts (Atom)