I would like to calculate heading direction from the north between 2 points with P1(lat1 , long2) and P2(lat2 long2), in excel.
It depends on what level of accuracy you are looking for. Haversine formula is simple yet may be insufficient since it assumes Earth surface is a perfect sphere (which it is not) and provides only limited accuracy.
Vincenty's formulae provide way better, geodesic grade accuracy (1.46E-6 degrees).
VBA Excel implementation I put together can be found on GitHub: https://github.com/tdjastrzebski/Vincenty-Excel.
VincentyInvFwdAzimuth() function should get you what you need.
I have a function used for ham radio calculations. A "pure" formula was too bulky for me.
Function BearingFromCoord(lat_base_deg, long_base_deg, lat_dest_deg, long_dest_deg As Single) As Long
Dim rad_deg_factor As Single
Dim long_diff As Single
Dim frac0 As Single
Dim frac1 As Single
Dim frac2 As Single
Dim lat_base As Single
Dim long_base As Single
Dim lat_dest As Single
Dim long_dest As Single
Dim bearing As Single
rad_deg_factor = 360 / (2 * pi())
long_diff = (long_base_deg - long_dest_deg) / rad_deg_factor
lat_base = lat_base_deg / rad_deg_factor
lat_dest = lat_dest_deg / rad_deg_factor
frac0 = Sin(lat_base) * Sin(lat_dest) _
+ Cos(lat_base) * Cos(lat_dest) _
* Cos(long_diff)
bearing = rad_deg_factor * Application.WorksheetFunction.Acos((Sin(lat_dest) _
- Sin(lat_base) * frac0) _
/ (Cos(lat_base) * Sin(WorksheetFunction.Acos(frac0))))
If Sin(long_diff) < 0 Then
BearingFromCoord = bearing
Else
BearingFromCoord = 360 - bearing
End If
End Function
Private Function pi() As Single
pi = 3.1415926535
End Function
I have a spreadsheet of addresses and I need to calculate the distance between all of their zip codes and my zip code. I'm fairly flexible on the method used, but I'm hoping for some sort of webservice or mathematic algorithm. US addresses only. Basically I need to feed in 2 zip codes and get out the distance between them.
I'm willing to use Excel formulas or VBA, and I can even code something in C#.net if needed.
How would you go about calculating these distances?
You could use Latitude and Longitude.
Excel:
=IF(SIN(Lat1) * SIN(Lat2) + COS(Lat1) * COS(Lat2) * COS(Long1 - Long2) > 1,
RadiusofEarth * ACOS(1), RadiusofEarth *
ACOS(SIN(Lat1) * SIN(Lat2) + COS(Lat1) * COS(Lat2) * COS(Long1-Long2)))
VB.net imports System.Math
Private Function Distance(ByVal lat1 As Double, ByVal lon1 As Double, ByVal lat2 As Double, ByVal lon2 As Double, ByVal unit As String) As Double
Dim theta As Double = lon1 - lon2
Dim dist = System.Math.Sin(deg2rad(lat1)) * System.Math.Sin(deg2rad(lat2)) + System.Math.Cos(deg2rad(lat1)) * System.Math.Cos(deg2rad(lat2)) * System.Math.Cos(deg2rad(theta))
dist = System.Math.Acos(dist)
dist = rad2deg(dist)
dist = dist * 60 * 1.1515
Select Case unit
Case "K"
dist = dist * 1.609344
Case "N"
dist = dist * 0.8684
End Select
Return dist
End Function
Other Useful Links(First one also mentions VBA alternatives)
ExcelLatLong (Also mentions VBA alternatives)
Zips by Lat Long Lookup
VBA discussion
EDIT: Link added due to comment discussion
More Info(Excel Formula)
It's pretty simple actually. Download a database of zip codes' GPS coordinates, there's plenty of sites that have this data available for download. They would list the coordinates for the center of the zip code.
Use a formula to calculate shortest distance: (ex: http://www.movable-type.co.uk/scripts/latlong.html)
How to create a Ceiling Function in MS access that behaves the same as the one in Excel?
Since Int() seems to work like Floor(), you can get Ceiling like this:
-Int(-x)
This answer uses VBA for Access, and is derived from http://www.tek-tips.com/faqs.cfm?fid=5031:
Public Function Ceiling(ByVal X As Double, Optional ByVal Factor As Double = 1) As Double
' X is the value you want to round
' Factor is the optional multiple to which you want to round, defaulting to 1
Ceiling = (Int(X / Factor) - (X / Factor - Int(X / Factor) > 0)) * Factor
End Function
Note that this answer is mathematically correct for negative X. See http://en.wikipedia.org/wiki/Floor_and_ceiling_functions#Spreadsheet_software for background.
Thanks, marg, for the answer. For future reference, here is the VBA function that I wrote after importing the Microsoft Excel Object Library:
Public Function Ceiling(Value As Double, Significance As Double) As Double
Ceiling = Excel.WorksheetFunction.Ceiling(Value, Significance)
End Function
Then in my query, I was trying to calculate billable hours from actual time worked, rounding up to the next quarter hour:
SELECT Ceiling(([WorkTimes]![EndTime]-[WorkTimes]![BeginTime])*24,0.25) AS BillableTime
FROM WorkTimes;
You can add a Reference to the Microsoft Excel Object Library and use Excel.WorksheetFunction.Ceiling
While this question specifically asked for Access here is the answer for VB.NET
Public Function Ceiling(ByVal value As Double, ByVal factor As Double) As Double
Return Math.Ceiling(value / factor) * factor
End Function
And the answer in C#
public double Ceiling(double value, double factor)
{
return Math.Ceiling(value / factor) * factor;
}
I'm posting it here because I needed such a function google sent me to this question but I couldn't find an answer for .Net. I finally figured it out for myself.
Whats the best way to round in VBA Access?
My current method utilizes the Excel method
Excel.WorksheetFunction.Round(...
But I am looking for a means that does not rely on Excel.
Be careful, the VBA Round function uses Banker's rounding, where it rounds .5 to an even number, like so:
Round (12.55, 1) would return 12.6 (rounds up)
Round (12.65, 1) would return 12.6 (rounds down)
Round (12.75, 1) would return 12.8 (rounds up)
Whereas the Excel Worksheet Function Round, always rounds .5 up.
I've done some tests and it looks like .5 up rounding (symmetric rounding) is also used by cell formatting, and also for Column Width rounding (when using the General Number format). The 'Precision as displayed' flag doesn't appear to do any rounding itself, it just uses the rounded result of the cell format.
I tried to implement the SymArith function from Microsoft in VBA for my rounding, but found that Fix has an error when you try to give it a number like 58.55; the function giving a result of 58.5 instead of 58.6. I then finally discovered that you can use the Excel Worksheet Round function, like so:
Application.Round(58.55, 1)
This will allow you to do normal rounding in VBA, though it may not be as quick as some custom function. I realize that this has come full circle from the question, but wanted to include it for completeness.
To expand a little on the accepted answer:
"The Round function performs round to even, which is different from round to larger."--Microsoft
Format always rounds up.
Debug.Print Round(19.955, 2)
'Answer: 19.95
Debug.Print Format(19.955, "#.00")
'Answer: 19.96
ACC2000: Rounding Errors When You Use Floating-Point Numbers: http://support.microsoft.com/kb/210423
ACC2000: How to Round a Number Up or Down by a Desired Increment: http://support.microsoft.com/kb/209996
Round Function: http://msdn2.microsoft.com/en-us/library/se6f2zfx.aspx
How To Implement Custom Rounding Procedures: http://support.microsoft.com/kb/196652
In Switzerland and in particulat in the insurance industry, we have to use several rounding rules, depending if it chash out, a benefit etc.
I currently use the function
Function roundit(value As Double, precision As Double) As Double
roundit = Int(value / precision + 0.5) * precision
End Function
which seems to work fine
Int and Fix are both useful rounding functions, which give you the integer part of a number.
Int always rounds down - Int(3.5) = 3, Int(-3.5) = -4
Fix always rounds towards zero - Fix(3.5) = 3, Fix(-3.5) = -3
There's also the coercion functions, in particular CInt and CLng, which try to coerce a number to an integer type or a long type (integers are between -32,768 and 32,767, longs are between-2,147,483,648 and 2,147,483,647). These will both round towards the nearest whole number, rounding away from zero from .5 - CInt(3.5) = 4, Cint(3.49) = 3, CInt(-3.5) = -4, etc.
1 place = INT(number x 10 + .5)/10
3 places = INT(number x 1000 + .5)/1000
and so on.You'll often find that apparently kludgy solutions like this are much faster than using Excel functions, because VBA seems to operate in a different memory space.
eg If A > B Then MaxAB = A Else MaxAB = B is about 40 x faster than using ExcelWorksheetFunction.Max
Unfortunately, the native functions of VBA that can perform rounding are either missing, limited, inaccurate, or buggy, and each addresses only a single rounding method. The upside is that they are fast, and that may in some situations be important.
However, often precision is mandatory, and with the speed of computers today, a little slower processing will hardly be noticed, indeed not for processing of single values. All the functions at the links below run at about 1 µs.
The complete set of functions - for all common rounding methods, all data types of VBA, for any value, and not returning unexpected values - can be found here:
Rounding values up, down, by 4/5, or to significant figures (EE)
or here:
Rounding values up, down, by 4/5, or to significant figures (CodePlex)
Code only at GitHub:
VBA.Round
They cover the normal rounding methods:
Round down, with the option to round negative values towards zero
Round up, with the option to round negative values away from zero
Round by 4/5, either away from zero or to even (Banker's Rounding)
Round to a count of significant figures
The first three functions accept all the numeric data types, while the last exists in three varieties - for Currency, Decimal, and Double respectively.
They all accept a specified count of decimals - including a negative count which will round to tens, hundreds, etc. Those with Variant as return type will return Null for incomprehensible input
A test module for test and validating is included as well.
An example is here - for the common 4/5 rounding. Please study the in-line comments for the subtle details and the way CDec is used to avoid bit errors.
' Common constants.
'
Public Const Base10 As Double = 10
' Rounds Value by 4/5 with count of decimals as specified with parameter NumDigitsAfterDecimals.
'
' Rounds to integer if NumDigitsAfterDecimals is zero.
'
' Rounds correctly Value until max/min value limited by a Scaling of 10
' raised to the power of (the number of decimals).
'
' Uses CDec() for correcting bit errors of reals.
'
' Execution time is about 1µs.
'
Public Function RoundMid( _
ByVal Value As Variant, _
Optional ByVal NumDigitsAfterDecimals As Long, _
Optional ByVal MidwayRoundingToEven As Boolean) _
As Variant
Dim Scaling As Variant
Dim Half As Variant
Dim ScaledValue As Variant
Dim ReturnValue As Variant
' Only round if Value is numeric and ReturnValue can be different from zero.
If Not IsNumeric(Value) Then
' Nothing to do.
ReturnValue = Null
ElseIf Value = 0 Then
' Nothing to round.
' Return Value as is.
ReturnValue = Value
Else
Scaling = CDec(Base10 ^ NumDigitsAfterDecimals)
If Scaling = 0 Then
' A very large value for Digits has minimized scaling.
' Return Value as is.
ReturnValue = Value
ElseIf MidwayRoundingToEven Then
' Banker's rounding.
If Scaling = 1 Then
ReturnValue = Round(Value)
Else
' First try with conversion to Decimal to avoid bit errors for some reals like 32.675.
' Very large values for NumDigitsAfterDecimals can cause an out-of-range error
' when dividing.
On Error Resume Next
ScaledValue = Round(CDec(Value) * Scaling)
ReturnValue = ScaledValue / Scaling
If Err.Number <> 0 Then
' Decimal overflow.
' Round Value without conversion to Decimal.
ReturnValue = Round(Value * Scaling) / Scaling
End If
End If
Else
' Standard 4/5 rounding.
' Very large values for NumDigitsAfterDecimals can cause an out-of-range error
' when dividing.
On Error Resume Next
Half = CDec(0.5)
If Value > 0 Then
ScaledValue = Int(CDec(Value) * Scaling + Half)
Else
ScaledValue = -Int(-CDec(Value) * Scaling + Half)
End If
ReturnValue = ScaledValue / Scaling
If Err.Number <> 0 Then
' Decimal overflow.
' Round Value without conversion to Decimal.
Half = CDbl(0.5)
If Value > 0 Then
ScaledValue = Int(Value * Scaling + Half)
Else
ScaledValue = -Int(-Value * Scaling + Half)
End If
ReturnValue = ScaledValue / Scaling
End If
End If
If Err.Number <> 0 Then
' Rounding failed because values are near one of the boundaries of type Double.
' Return value as is.
ReturnValue = Value
End If
End If
RoundMid = ReturnValue
End Function
If you're talking about rounding to an integer value (and not rounding to n decimal places), there's always the old school way:
return int(var + 0.5)
(You can make this work for n decimal places too, but it starts to get a bit messy)
Lance already mentioned the inherit rounding bug in VBA's implementation.
So I need a real rounding function in a VB6 app.
Here is one that I'm using. It is based on one I found on the web as is indicated in the comments.
' -----------------------------------------------------------------------------
' RoundPenny
'
' Description:
' rounds currency amount to nearest penny
'
' Arguments:
' strCurrency - string representation of currency value
'
' Dependencies:
'
' Notes:
' based on RoundNear found here:
' http://advisor.com/doc/08884
'
' History:
' 04/14/2005 - WSR : created
'
Function RoundPenny(ByVal strCurrency As String) As Currency
Dim mnyDollars As Variant
Dim decCents As Variant
Dim decRight As Variant
Dim lngDecPos As Long
1 On Error GoTo RoundPenny_Error
' find decimal point
2 lngDecPos = InStr(1, strCurrency, ".")
' if there is a decimal point
3 If lngDecPos > 0 Then
' take everything before decimal as dollars
4 mnyDollars = CCur(Mid(strCurrency, 1, lngDecPos - 1))
' get amount after decimal point and multiply by 100 so cents is before decimal point
5 decRight = CDec(CDec(Mid(strCurrency, lngDecPos)) / 0.01)
' get cents by getting integer portion
6 decCents = Int(decRight)
' get leftover
7 decRight = CDec(decRight - decCents)
' if leftover is equal to or above round threshold
8 If decRight >= 0.5 Then
9 RoundPenny = mnyDollars + ((decCents + 1) * 0.01)
' if leftover is less than round threshold
10 Else
11 RoundPenny = mnyDollars + (decCents * 0.01)
12 End If
' if there is no decimal point
13 Else
' return it
14 RoundPenny = CCur(strCurrency)
15 End If
16 Exit Function
RoundPenny_Error:
17 Select Case Err.Number
Case 6
18 Err.Raise vbObjectError + 334, c_strComponent & ".RoundPenny", "Number '" & strCurrency & "' is too big to represent as a currency value."
19 Case Else
20 DisplayError c_strComponent, "RoundPenny"
21 End Select
End Function
' -----------------------------------------------------------------------------
VBA.Round(1.23342, 2) // will return 1.23
To solve the problem of penny splits not adding up to the amount that they were originally split from, I created a user defined function.
Function PennySplitR(amount As Double, Optional splitRange As Variant, Optional index As Integer = 0, Optional n As Integer = 0, Optional flip As Boolean = False) As Double
' This Excel function takes either a range or an index to calculate how to "evenly" split up dollar amounts
' when each split amount must be in pennies. The amounts might vary by a penny but the total of all the
' splits will add up to the input amount.
' Splits a dollar amount up either over a range or by index
' Example for passing a range: set range $I$18:$K$21 to =PennySplitR($E$15,$I$18:$K$21) where $E$15 is the amount and $I$18:$K$21 is the range
' it is intended that the element calling this function will be in the range
' or to use an index and total items instead of a range: =PennySplitR($E$15,,index,N)
' The flip argument is to swap rows and columns in calculating the index for the element in the range.
' Thanks to: http://stackoverflow.com/questions/5559279/excel-cell-from-which-a-function-is-called for the application.caller.row hint.
Dim evenSplit As Double, spCols As Integer, spRows As Integer
If (index = 0 Or n = 0) Then
spRows = splitRange.Rows.count
spCols = splitRange.Columns.count
n = spCols * spRows
If (flip = False) Then
index = (Application.Caller.Row - splitRange.Cells.Row) * spCols + Application.Caller.Column - splitRange.Cells.Column + 1
Else
index = (Application.Caller.Column - splitRange.Cells.Column) * spRows + Application.Caller.Row - splitRange.Cells.Row + 1
End If
End If
If (n < 1) Then
PennySplitR = 0
Return
Else
evenSplit = amount / n
If (index = 1) Then
PennySplitR = Round(evenSplit, 2)
Else
PennySplitR = Round(evenSplit * index, 2) - Round(evenSplit * (index - 1), 2)
End If
End If
End Function
I used the following simple function to round my currencies as in our company we always round up.
Function RoundUp(Number As Variant)
RoundUp = Int(-100 * Number) / -100
If Round(Number, 2) = Number Then RoundUp = Number
End Function
but this will ALWAYS round up to 2 decimals and may also error.
even if it is negative it will round up (-1.011 will be -1.01 and 1.011 will be 1.02)
so to provide more options for rounding up (or down for negative) you could use this function:
Function RoundUp(Number As Variant, Optional RoundDownIfNegative As Boolean = False)
On Error GoTo err
If Number = 0 Then
err:
RoundUp = 0
ElseIf RoundDownIfNegative And Number < 0 Then
RoundUp = -1 * Int(-100 * (-1 * Number)) / -100
Else
RoundUp = Int(-100 * Number) / -100
End If
If Round(Number, 2) = Number Then RoundUp = Number
End Function
(used in a module, if it isn't obvious)
Here is easy way to always round up to next whole number in Access 2003:
BillWt = IIf([Weight]-Int([Weight])=0,[Weight],Int([Weight])+1)
For example:
[Weight] = 5.33 ; Int([Weight]) = 5 ; so 5.33-5 = 0.33 (<>0), so answer is BillWt = 5+1 = 6.
[Weight] = 6.000, Int([Weight]) = 6 , so 6.000-6 = 0, so answer is BillWt = 6.
Public Function RoundUpDown(value, decimals, updown)
If IsNumeric(value) Then
rValue = Round(value, decimals)
rDec = 10 ^ (-(decimals))
rDif = rValue - value
If updown = "down" Then 'rounding for "down" explicitly.
If rDif > 0 Then ' if the difference is more than 0, it rounded up.
RoundUpDown = rValue - rDec
ElseIf rDif < 0 Then ' if the difference is less than 0, it rounded down.
RoundUpDown = rValue
Else
RoundUpDown = rValue
End If
Else 'rounding for anything thats not "down"
If rDif > 0 Then ' if the difference is more than 0, it rounded up.
RoundUpDown = rValue
ElseIf rDif < 0 Then ' if the difference is less than 0, it rounded down.
RoundUpDown = rValue + rDec
Else
RoundUpDown = rValue
End If
End If
End If
'RoundUpDown(value, decimals, updown) 'where updown is "down" if down. else rounds up. put this in your program.
End Function