1

I am trying to write a formula that takes into consideration 'n' amount of customers at 'x' address and how much they order ('q'). I would like for the formula to then print out the latitude/longitude of the best location that the 'centroid' warehouse should be.

I would prefer for it to be a command such as =getCentroid.

Thanks for any help.

EDIT

Since some people might think that this is too broad or does not have enough information -- I will provide an old code I have.

This code takes the latitudes and longitudes that I enter, and then considers the number of shipments and then proceeds to tell me where the new warehouse should be. It is so old, that I am not sure how it works.

Private Sub CommandButton1_Click()
Dim i As Integer
Dim j As Integer
Dim count As Integer
i = 3
j = 0
count = 3
dtr = 0.0174533 'degrees to radians calculation
RTD = 57.2958 'radians to degrees
LatFactor = 69.172 'miles in 1 degree change in lat



'Finds how many locations there are around whs as j
Do While Cells(i, 2) <> ""
    j = j + 1
    lats = lats + Cells(i, 2)
    Longs = Longs + Cells(i, 3)
    i = i + 1
Loop


'Create arrays of lats and longs starting at  0
Dim lat() As Variant
ReDim lat(0 To j)
Dim lon() As Variant
ReDim lon(0 To j)
For x = 1 To j
    lat(count - 3) = Cells(count, 2)
    lon(count - 3) = Cells(count, 3)
    count = count + 1
Next

R = 3959 'Radius of earth
whsLat = Cells(2, 2) 'Lattitude of Whs in NOT Radians
whsLon = Cells(2, 3) 'Lattitude of whs NOT in rads
whsLatr = Cells(2, 2) * dtr
whsLonr = Cells(2, 3) * dtr


'Calculates distance from warehouse to location 1 as d
'uses haversine formula-as crow flies

Dim Distances() As Variant
ReDim Distances(0 To j)
For x = 1 To j
    Clat = lat(x - 1) * dtr
    deltaLat = (lat(x - 1) - whsLat) * dtr
    deltaLon = (lon(x - 1) - whsLon) * dtr
    a = (Math.Sin(deltaLat / 2) * Math.Sin(deltaLat / 2)) +                
(Math.Cos(whsLatr) * Math.Cos(Clat) * Math.Sin(deltaLon / 2) *         
Math.Sin(deltaLon / 2))
    c = 2 * Math.Atn((Math.Sqr(a) / Math.Sqr(1 - a)))
    d = R * c
    Distances(x - 1) = d 'distance values
    Cells(x + 2, 13) = d
Next
TotalMiles = WorksheetFunction.Sum(Distances)
step = 1


'Calculate optimum location using halves

Olat = lat(0)
Olon = lon(0)
OLatr = lat(0) * dtr
OLonr = lon(0) * dtr
Dlat = lat(1)
DLatr = lat(1) * dtr
Dlon = lon(1)
Dlonr = lon(1) * dtr
LatChange = (lat(1) - Olat) * dtr
LonChange = (lon(1) - Olon) * dtr

'Counting Variables for weight
y = 3
Z = 4
ShipSum = Cells(y, 4) + Cells(Z, 4)
For x = 1 To j - 1
anew = (Math.Sin(LatChange / 2) * Math.Sin(LatChange / 2)) +     
(Math.Cos(OLatr) * Math.Cos(DLatr) * Math.Sin(LonChange / 2) * 
Math.Sin(LonChange / 2))
cnew = 2 * Math.Atn((Math.Sqr(anew) / Math.Sqr(1 - anew)))
dnew = R * cnew
'Calculate new lat and long
hyp = dnew / 2 ' Total distance moved
adj = Abs(LatFactor * (Dlat - Olat)) 'y distance
Degree = WorksheetFunction.Acos(adj / dnew * dtr) 'degree from 90
If (Dlat - Olat) > 0 Then NewLat = Olat + (Cells(Z, 4) / (ShipSum)) *         
Abs(hyp / LatFactor * Math.Cos(Degree) * RTD) 'New lattitude if going up
If (Dlat - Olat) < 0 Then NewLat = Olat - (Cells(Z, 4) / (ShipSum)) *     
Abs(hyp / LatFactor * Math.Cos(Degree) * RTD) 'New Lattitude if going down
Opp = (Dlon - Olon) * Math.Cos(NewLat * dtr) 'x distance adjusted for polar     
flattening
If (Dlon - Olon > 0) Then NewLon = Olon + (Cells(Z, 4) / (ShipSum)) *     
Abs(Opp) 'new long
If (Dlon - Olon < 0) Then NewLon = Olon - (Cells(Z, 4) / (ShipSum)) *     
Abs(Opp)
Olat = NewLat 'Setting new origin
Olon = NewLon
OLatr = NewLat * dtr
OLonr = NewLon * dtr
If x < j Then
    Dlat = lat(x + 1) 'If there is another iteration, set new destination
    DLatr = lat(x + 1) * dtr
    Dlon = lon(x + 1)
    Dlonr = lon(x + 1) * dtr
    LatChange = (lat(x + 1) - Olat) * dtr
    LonChange = (lon(x + 1) - Olon) * dtr
    y = y + 1
    Z = Z + 1
    ShipSum = ShipSum + Cells(Z, 4)
End If
Next

Cells(3, 8) = NewLat
Cells(3, 9) = "-" & NewLon

whsLat = NewLat 'Lattitude of New Whs in NOT Radians
whsLon = NewLon 'Lattitude of whs NOT in rads
whsLatr = NewLat * dtr
whsLonr = NewLon * dtr


'Calculates distance from warehouse to location 1 as d
'uses haversine formula-as crow flies

Dim NewDistances() As Variant
ReDim NewDistances(0 To j)
For x = 1 To j
    Clat = lat(x - 1) * dtr
    deltaLat = (lat(x - 1) - whsLat) * dtr
    deltaLon = (lon(x - 1) - whsLon) * dtr
    a = (Math.Sin(deltaLat / 2) * Math.Sin(deltaLat / 2)) +     
(Math.Cos(whsLatr) * Math.Cos(Clat) * Math.Sin(deltaLon / 2) *     
Math.Sin(deltaLon / 2))
    c = 2 * Math.Atn((Math.Sqr(a) / Math.Sqr(1 - a)))
    d = R * c
    Cells(x + 2, 10) = d
    NewDistances(x - 1) = d 'distance values
Next
NewTotalMiles = WorksheetFunction.Sum(NewDistances)
Cells(j + 3, 10) = NewTotalMiles
Worksheets("Sheet1").Range("K3:K100").ClearContents

i = 3
Do While i < 44
    Cells(i, 11) = Cells(i, 10) * Cells(i, 4)
    i = i + 1
Loop
Cells(11, 11) = Cells(3, 11) + Cells(4, 11) + Cells(5, 11) + Cells(6, 11) +     
Cells(7, 11) + Cells(8, 11) + Cells(9, 11) + Cells(10, 11)
End Sub
11
  • 2
    This is much too broad: en.wikipedia.org/wiki/Facility_location_problem If you want a command which can be used as a UDF (=getCentroid) you will have to 1) carefully formulate your problem (with much more detail than you give in the question), 2) decide on an algorithm to solve it, at least heuristically, and 3) implement your algorithm in VBA. Perhaps you can edit your question so that at least 1 above is done. Jul 26, 2017 at 17:46
  • @JohnColeman check my edit
    – nola94
    Jul 26, 2017 at 17:59
  • Yes, that does help to clarify it. Jul 26, 2017 at 18:00
  • There is much about that code which is obscure (e.g. lats = lats + Cells(i, 2) -- why add latitudes together? There is no geometric motivation for doing so and the variable lats isn't even used anywhere in the rest of the code). I would consider throwing the code away and starting from scratch. It shouldn't be too hard to find pseudocode for computing the centroid of a discrete mass distribution on the surface of a sphere (where presumably the mass at a given location is the quantity there) and it shouldn't be too hard to code it in VBA. Might be easier than trying to decipher old code. Jul 26, 2017 at 20:17
  • For example, this idea should be easy to implement: math.stackexchange.com/a/1907447/294695 Jul 26, 2017 at 20:23

1 Answer 1

1

Here is some code which handles the mathematical part of computing the weighted-centroid on the surface of the sphere:

'the following code assumes that A is a 4 column, 1-based, 2-dimensional array whose
'first three columns are the x,y,z coordinats of a point on a sphere centered at the origin
'and whose 4th column is the mass at that point
'returns a 0-based variant array of the x,y,z coordinates of the centroid

Function SphericalCentroid(A As Variant) As Variant
    Dim r As Double 'radius of sphere
    Dim pm As Double 'point-mass
    Dim m As Double 'total mass
    Dim mxy As Double, mxz As Double, myz As Double 'moments about coordinate planes
    Dim xbar As Double, ybar As Double, zbar As Double 'true centroid
    Dim d As Double 'distance of true centroid from center -- used to project to surface
    Dim i As Long, n As Long
    
    If TypeName(A) = "Range" Then A = A.Value
    n = UBound(A)
    r = Sqr(A(1, 1) ^ 2 + A(1, 2) ^ 2 + A(1, 3) ^ 2)
    For i = 1 To n
        pm = A(i, 4)
        m = m + pm
        myz = myz + pm * A(i, 1)
        mxz = mxz + pm * A(i, 2)
        mxy = mxy + pm * A(i, 3)
    Next i
    xbar = myz / m
    ybar = mxz / m
    zbar = mxy / m
    d = Sqr(xbar ^ 2 + ybar ^ 2 + zbar ^ 2)
    If d < 0.001 * r Then 'located at the center -- return pole
        SphericalCentroid = Array(0, 0, r)
    Else
        SphericalCentroid = Array(xbar * r / d, ybar * r / d, zbar * r / d)
    End If
End Function

The following screenshot shows how it could be used:

enter image description here

In the above I used the array formula (=SphericalCentroid(A2:D4)) in cells A5:C5 (entered with Ctrl + Shift + Enter).

The code first computes the center of mass in 3-dimensional space (which will locate it somewhere in the interior of the sphere) and then projects it onto the sphere itself.

To use this for your problem, you would need to create a wrapper function which translates from latitude/longitude to Cartesian coordinates (approximating the earth as a sphere -- which does have its problems), invoking the above function, and then translating back to latitude/longitude.

On Edit For fun, I wrote a wrapper function:

'the following function takes a 3-column range, the first column is decimal latitude,
'the second is decimal longitude (assuming in North America),
'the third is number of shipments from that location
'the return value is the decimal latitude and longitude of
'the centroid

Function GetCentroid(data As Range) As Variant
    Dim r As Double
    Dim lat As Double, lon As Double
    Dim x As Double, y As Double, z As Double
    Dim A As Variant
    Dim i As Long, n As Long
    Dim centroid As Variant
    
    r = 3959 'radius of earth
    n = data.Rows.Count
    ReDim A(1 To n, 1 To 4)
    
    With Application.WorksheetFunction
        For i = 1 To n
            lat = .Radians(data.Cells(i, 1).Value)
            lon = .Radians(data.Cells(i, 2).Value)
            A(i, 1) = r * Cos(lat) * Cos(lon)
            A(i, 2) = r * Cos(lat) * Sin(lon)
            A(i, 3) = r * Sin(lat)
            A(i, 4) = data.Cells(i, 3).Value
        Next i
        centroid = SphericalCentroid(A)
        x = centroid(0)
        y = centroid(1)
        z = centroid(2)
        lat = .Degrees(.Asin(z / r))
        lon = .Degrees(.Atan2(x, y))
    End With
    GetCentroid = Array(lat, lon)
End Function

Used like:

enter image description here

The three locations in the input list are at Cleveland, Cincinnati, and Pittsburgh respectively, and the returned centroid is in central Ohio (somewhat close to Zanesville -- which seems plausible enough).

I doubt that it is anything better than a crude heuristic, but it gives a rough idea for where a good location would be.

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

Not the answer you're looking for? Browse other questions tagged or ask your own question.