Finding all possible combos for n * m array, excluding certain values - arrays

I have an array that can vary in size, with n columns and m rows, and I need to find all the combinations of one element for each row/column combination, but exclude any combinations where the element is zero. So, in practice, if I have:
Row
Item1
Item2
Item3
1
A
B
C
2
D
E
F
I will have 2^3 = 8 possible combinations: ABC, ABF, AEC, AEF, DBC, DBF, DEC, DEF.
But if instead of B I have a zero in row 1 Item2, I want to exclude that cell from the list of combinations (in bold above), so I would end up with: AEC, AEF, DEC and DEF.
I found some code that give me all the possible combinations on a fixed number of columns (Macro to make all possible combinations of data in various columns in excel sheet), but it doesn't account for an array that can change dimensions, or for the exclusion rule above.

I'm just going to post the code for the simple (no zeroes) case so you can see where I'm going with this (of course I have realised that Base switches over to letters for radix 11 onwards so this might not be the smartest approach :) )
Function ListCombos(r As Range)
Dim s As String, result As String
Dim arr()
Dim j As Integer, offset As Integer
Dim rows As Integer, cols As Integer
Dim nComb As Long, i As Long
rows = r.rows.Count
cols = r.Columns.Count
nComb = rows ^ cols
ReDim arr(1 To nComb)
For i = 1 To nComb
s = Application.Base(i - 1, rows, cols)
result = ""
For j = 1 To cols
offset = CInt(Mid(s, j, 1))
result = result & r.Cells(1, 1).offset(offset, j - 1)
Next j
arr(i) = result
Next i
ListCombos = arr
End Function
This is the version skipping combinations which contain zeroes. The method is to move non-zero values to the first rows of a holding array so effectively if you start with something like this
You make it look like this
So you don't have to generate or check all the combinations that contain zeroes.
Then use mixed radix to cycle through the combinations:
Option Explicit
Option Base 1
Function ListCombosWithZeroes(r As Range)
Dim s As String, result As String
Dim arr()
Dim i As Integer, j As Integer, offset As Integer, count As Integer, carry As Integer, temp As Integer
Dim rows As Integer, cols As Integer
Dim nComb As Long, iComb As Long
Dim holdingArr(20, 20) As String
Dim countArr(20) As Integer
Dim countUpArr(20) As Integer
rows = r.rows.count
cols = r.Columns.count
' Move non-zero cells to first rows of holding array and establish counts per column
For j = 1 To cols
count = 0
For i = 1 To rows
If r.Cells(i, j) <> 0 Then
count = count + 1
holdingArr(count, j) = r.Cells(i, j)
End If
Next i
countArr(j) = count
Next j
' Calculate number of combos
nComb = 1
For j = 1 To cols
nComb = nComb * countArr(j)
Next j
ReDim arr(1 To nComb)
'Loop through combos
For iComb = 1 To nComb
result = ""
For j = 1 To cols
offset = countUpArr(j)
result = result & holdingArr(offset + 1, j)
Next j
arr(iComb) = result
'Increment countup Array - this is the hard part.
j = cols
'Set carry=1 to force increment on right-hand column
carry = 1
Do
temp = countUpArr(j) + carry
countUpArr(j) = temp Mod countArr(j)
carry = temp \ countArr(j)
j = j - 1
Loop While carry > 0 And j > 0
Next iComb
ListCombosWithZeroes = arr
End Function
You don't have to have equal numbers of letters per column.

Here's a solution. Probably not most efficient, since it is O(n2), but it works.
Caveats
I put a '.' instead of zero to avoid dealing with numeric vs alphanumeric values, but you can easily change this
Since I build the strings incrementally I need indices to be predictable. Hence I fill all the possible combinations and then remove the ones containing a '.' in a second pass
Global aws As Worksheet
Global ur As Range
Global ccount, rcount, size, rptline, rptblock, iblk, iln, idx As Integer
Global tempcombos(), combos() As String
Public Sub Calc_combos()
Set aws = Application.ActiveSheet
Set ur = aws.UsedRange
ccount = ur.Columns.Count
rcount = ur.Rows.Count
size = (rcount - 1) ^ (ccount - 1)
ReDim tempcombos(size - 1)
ReDim combos(size - 1)
rptline = size / (rcount - 1)
rptblock = 1
For c = 2 To ccount
idx = 0
For iblk = 1 To rptblock
For r = 2 To rcount
For iln = 1 To rptline
tempcombos(idx) = tempcombos(idx) & Cells(r, c)
idx = idx + 1
Next iln
Next r
Next iblk
rptline = rptline / (rcount - 1)
rptblock = rptblock * (rcount - 1)
Next c
idx = 0
For iln = 0 To size - 1
If InStr(tempcombos(iln), ".") = 0 Then
combos(idx) = tempcombos(iln)
idx = idx + 1
End If
Next iln
End Sub

The Python way:
from dataclasses import dataclass, field
from itertools import product
from random import randint
from typing import Dict, List
#dataclass
class PriceComparison():
rows : int
cols : int
maxprice : int = 50
threshold : int = 0
itemcodes : List[List[str]] = field(init=False)
pricelist : Dict[str, int] = field(init=False)
def __post_init__(self):
##create sample data
self.itemcodes = [[f'A{r+self.cols*c:03d}' for c in range(self.rows)] for r in range(self.cols)]
print(self.itemcodes)
self.pricelist = {self.itemcodes[c][r]:randint(0,self.maxprice) for r in range(self.rows) for c in range(self.cols)}
##remove items with price = 0
for col in self.itemcodes:
for item in col[:]:
if self.pricelist[item] == 0:
print(f'removing {item} from {col}')
col.remove(item)
del self.pricelist[item]
def find_cheapest(self):
iterations = 1
for col in self.itemcodes:
iterations *= len(col)
print(f'this may require {iterations} iterations!')
cheapest = self.maxprice * self.cols + 1
for i, combo in enumerate(product(*self.itemcodes)):
##dummy price calculation
price = sum([self.pricelist[item] for item in combo]) * randint(1,10) // 10
if price < cheapest:
print(f'current cheapest is {price} at iteration {i}')
cheapest = price
if price < self.threshold:
print('under threshold: returning')
break
return cheapest
Some notes:
I assume the cheapest combo is not simply given by selecting the cheapest item in each column, otherwise we would not need all this complicated machinery; so I inserted a random coefficient while calculating the total price of a combo - this should be replaced with the actual formula
I also assume we have item codes in our input table, with prices for each item stored elsewhere. As sample data I create codes from 'A000' to 'Axxx', and assign a random price between 0 and a maxprice to each one
Items with price = 0 are removed immediately, before the search for the cheapest combo
For large input tables the search will take a very long time. So although it wasn't requested I also added an optional threshold parameter: if we find a total price under that value we consider it is cheap enough and stop the search
EDIT
The following is a Python 3.5 compatible version.
However it must be noted that with a 10x15 input table the number of required iterations will be somewhere near 1E+15 (something less actually, depending on how many cells we are able to ignore as "obvious outliers"). Even if we check 1 million combos per second it will still run for (something less than) 1E+09 seconds, or about 32 years.
So we need a way to improve our strategy. I integrated two options:
Setting a threshold, so that we don't search for the actual best price but stop as soon as we find an "acceptable" one
Splitting the tables in "zones" (subsets of columns), looking for the best partial solution for each zone and then combining them.
Sample runs:
##10 x 15, 5 zones, each 3 columns wide
this may require up to 1.000000e+03 iterations!
...
current best price is 1 at iteration 71 in 0.06 secs
this may require up to 1.000000e+03 iterations!
...
current best price is 2 at iteration 291 in 0.11 secs
this may require up to 1.000000e+03 iterations!
...
current best price is 1 at iteration 330 in 0.07 secs
this may require up to 8.100000e+02 iterations!
...
current best price is 4 at iteration 34 in 0.09 secs
this may require up to 1.000000e+03 iterations!
...
current best price is 1 at iteration 82 in 0.07 secs
['A000', 'A106', 'A017', 'A033', 'A139', 'A020', 'A051', 'A052', 'A008', 'A009', 'A055', 'A131', 'A147', 'A133', 'A044']
##10 x 15, no zones, threshold = 25
this may require up to 8.100000e+14 iterations!
...
current best price is 24 at iteration 267493282 in 1033.24 secs
under threshold: returning
['A000', 'A001', 'A002', 'A003', 'A004', 'A005', 'A051', 'A052', 'A008', 'A039', 'A055', 'A071', 'A042', 'A133', 'A044']
Code follows:
from itertools import product
from random import randint
from time import time
class PriceComparison():
def __init__(self, rows, cols, zones = [], maxprice = 50, threshold = 0):
self.rows = rows
self.cols = cols
if zones == []:
self.zones = [cols]
else:
self.zones = zones
self.maxprice = maxprice
self.threshold = threshold
self.__post_init__()
def __post_init__(self):
##create sample data
self.itemcodes = [['A%03d' % (r+self.cols*c) for c in range(self.rows)] for r in range(self.cols)]
print(self.itemcodes)
self.pricelist = {self.itemcodes[c][r]:randint(0,self.maxprice) for r in range(self.rows) for c in range(self.cols)}
##remove items with price = 0
for col in self.itemcodes:
for item in col[:]:
if self.pricelist[item] == 0:
print('removing %s from %s' % (item, col))
col.remove(item)
del self.pricelist[item]
def find_cheapest(self, lo, hi):
iterations = 1
for col in self.itemcodes[lo:hi]:
iterations *= len(col)
start = time()
print('\nthis may require up to %e iterations!' % (iterations))
bestprice = self.maxprice * self.cols + 1
for i, combo in enumerate(product(*self.itemcodes[lo:hi])):
##dummy price calculation
price = sum([self.pricelist[item] for item in combo]) * randint(1,10) // 10
if price < bestprice:
elapsed = time() - start
print('current best price is %d at iteration %d in %.2f secs' % (price, i, elapsed))
cheapest = combo
bestprice = price
if price < self.threshold:
print('under threshold: returning')
break
return cheapest
def find_by_zones(self):
print(self.zones)
fullcombo = []
lo = 0
for zone in self.zones:
hi = lo + zone
fullcombo += self.find_cheapest(lo, hi)
lo = hi
return fullcombo

Related

Maximum cost of Matrix

You are given an N*M 2D matrix, Each cell contains a number and no two cells have the same number. We have to select one element from each of the N rows, let selected elements be c1,c2,...cN.
The cost of Matrix is defined as - the sum of (ci-sj)(1<=i,j<=N) where sj represents the greatest element in jth row that is <=ci, If no such sj exists then sj=0.
We have to find the maximum possible cost of the matrix.
For Example:-
If N=M=3 and matrix = [[4,3,2], [6,1,5], [8,9,7]]
Now the values for c1 can be 4,3 or 2, values for c2 can be 6,1 or 5 and values for c3 can be 8,9 or 7
If we select c1=4, c2=6 and c3=9
Cost of c1 = (4-4)+(4-1)+(4-0)=7, here s1 = 4(greatest element <=c1=4 in 1st row), s2 = 1, s3 = 0(as no element is <=c3=9 in 3rd row)
similarly, Cost of c2 = (6-4)+(6-6)+(6-0)=8
cost of c3 = (9-4)+(9-6)+(9-9) = 8
Total Cost = 7+8+8 = 23
This is the maximum score that we can get from any values of c1,c2,c3.
Another Example:-
If Matrix = [[2,22,28,30],[21,5,14,4],[20,6,15,23]] then maximum cost would be 60.
I tried choosing the maximum element from each row as ci, but this does not work. Can anyone tell how we can approach and solve this problem?
Edit:
I have tried long for coding and understanding this but am unable to do so successfully, here is what I am able to code until now, this passes some cases but fails some.
def solve(matrix):
N = len(matrix)
M = len(matrix[1])
i = 0
totalcost = 0
for row in matrix:
itotalcost = 0
for ci in row:
icost = 0
totalicost = 0
for k in range(0, N):
if k != i:
idx = 0
sj = 0
isj = 0
for idx in range(0, M):
isj = matrix[k][idx]
if isj <= ci and isj > sj:
sj = isj
icost = ci - sj
totalicost += icost
#print("ci=", ci, "sj", sj, "icost=", icost)
if itotalcost < totalicost:
itotalcost = totalicost
i += 1
#print("itotalcost=", itotalcost)
totalcost += itotalcost
return totalcost
You can solve this in O(N log N) time, where N is the total number of elements.
First, we can define the value of a nonnegative integer x independently of what row it is in. Letting max_at_most(row, x) denote a function returning the largest element in row that is at most x, or 0 if none exists.
Then:
value(x) = sum over all rows R of: { x - max_at_most(R, x) }
Now, max_at_most is a monotonic function of x for a fixed row, and it only changes at most length(row) times for each row, which we can use to calculate it quickly.
Find all unique elements in your matrix, and track the row indices where each element occurs. Sort the unique elements. Now, if we iterate over the elements in order, we can track the largest elements seen in each row (and also the sum of max_at_most(row, x) over all rows) in O(1) time.
def max_matrix_value(matrix: List[List[int]]) -> int:
"""Maximize the sum over all rows i, j, of (c_i - f(j, c_i)})
where c_i must be an element of row i and f(j, c_i) is the largest
element of row j less than or equal to c_i, or 0 if none exists."""
num_rows = len(matrix)
elem_to_indices = defaultdict(list)
for index, row in enumerate(matrix):
for elem in row:
elem_to_indices[elem].append(index)
current_max_element = [0] * num_rows
current_max_sum = 0
max_value_by_row = [0] * num_rows
for element in sorted(elem_to_indices):
# Update maximum element seen in each row
for index in elem_to_indices[element]:
difference = element - current_max_element[index]
current_max_sum += difference
current_max_element[index] = element
max_value_for_element = element * num_rows - current_max_sum
# Update maximum value achieved by row, if we have a new record
for index in elem_to_indices[element]:
max_value_by_row[index] = max(max_value_by_row[index],
max_value_for_element)
return sum(max_value_by_row)

Vectorizing a code that requires to complement some elements of a binary array

I have a matrix A of dimension m-by-n composed of zeros and ones, and a matrix J of dimension m-by-1 reporting some integers from [1,...,n].
I want to construct a matrix B of dimension m-by-n such that for i = 1,...,m
B(i,j) = A(i,j) for j=1,...,n-1
B(i,n) = abs(A(i,n)-1)
If sum(B(i,:)) is odd then B(i,J(i)) = abs(B(i,J(i))-1)
This code does what I want:
m = 4;
n = 5;
A = [1 1 1 1 1; ...
0 0 1 0 0; ...
1 0 1 0 1; ...
0 1 0 0 1];
J = [1;2;1;4];
B = zeros(m,n);
for i = 1:m
B(i,n) = abs(A(i,n)-1);
for j = 1:n-1
B(i,j) = A(i,j);
end
if mod(sum(B(i,:)),2)~=0
B(i,J(i)) = abs(B(i,J(i))-1);
end
end
Can you suggest more efficient algorithms, that do not use the nested loop?
No for loops are required for your question. It just needs an effective use of the colon operator and logical-indexing as follows:
% First initialize B to all zeros
B = zeros(size(A));
% Assign all but last columns of A to B
B(:, 1:end-1) = A(:, 1:end-1);
% Assign the last column of B based on the last column of A
B(:, end) = abs(A(:, end) - 1);
% Set all cells to required value
% Original code which does not work: B(oddRow, J(oddRow)) = abs(B(oddRow, J(oddRow)) - 1);
% Correct code:
% Find all rows in B with an odd sum
oddRow = find(mod(sum(B, 2), 2) ~= 0);
for ii = 1:numel(oddRow)
B(oddRow(ii), J(oddRow(ii))) = abs(B(oddRow(ii), J(oddRow(ii))) - 1);
end
I guess for the last part it is best to use a for loop.
Edit: See the neat trick by EBH to do the last part without a for loop
Just to add to #ammportal good answer, also the last part can be done without a loop with the use of linear indices. For that, sub2ind is useful. So adopting the last part of the previous answer, this can be done:
% Find all rows in B with an odd sum
oddRow = find(mod(sum(B, 2), 2) ~= 0);
% convert the locations to linear indices
ind = sub2ind(size(B),oddRow,J(oddRow));
B(ind) = abs(B(ind)- 1);

Excel VBA to SQL Server - Transition Matrix

I have code in VBA that works to generate a transition matrix on data in excel. I now have access to a huge SQL DB with ~2MM rows of information and would like to generate a transition matrix which looks something like this:
In any case here is the VBA code:
Option Explicit
Function COHORT(id, dat, rat, _
Optional classes As Integer, Optional ystart, Optional yend)
'Function is written for data sorted according to issuers and rating dates (ascending),
'rating classes numbered from 1 to classes, last rating class=default, not rated has number "0"
If IsMissing(ystart) Then ystart = Year(Application.WorksheetFunction.min(dat))
If IsMissing(yend) Then yend = Year(Application.WorksheetFunction.Max(dat)) - 1
If classes = 0 Then classes = Application.WorksheetFunction.Max(rat)
Dim obs As Long, k As Long, kn As Long, i As Integer, j As Integer, t As Integer
Dim ni() As Long, nij() As Long, pij() As Double, newrat As Integer
ReDim nij(1 To classes - 1, 0 To classes), ni(0 To classes)
obs = id.Rows.count
For k = 1 To obs
'Earliest cohort to which observation can belong is from year:
t = Application.Max(ystart, Year(dat(k)))
'Loop through cohorts to which observation k can belong
Do While t < yend
'Is there another rating from the same year?
If id(k + 1) = id(k, 1) And Year(dat(k + 1)) <= t And k <> obs Then
Exit Do
End If
'Is the issuer in default or not rated?
If rat(k) = classes Or rat(k) = 0 Then Exit Do
'Add to number of issuers in cohort
ni(rat(k)) = ni(rat(k)) + 1
'Determine rating from end of next year (=y+1)
'rating stayed constant
If id(k + 1) <> id(k) Or Year(dat(k + 1)) > t + 1 Or k = obs Then
newrat = rat(k)
'rating changed
Else
kn = k + 1
Do While Year(dat(kn + 1)) = Year(dat(kn)) And id(kn + 1) = id(kn)
If rat(kn) = classes Then Exit Do 'Default is absorbing!
kn = kn + 1
Loop
newrat = rat(kn)
End If
'Add to number of transitions
nij(rat(k), newrat) = nij(rat(k), newrat) + 1
'Exit if observation k cannot belong to cohort of y+1
If newrat <> rat(k) Then Exit Do
t = t + 1
Loop
Next k
ReDim pij(1 To classes - 1, 1 To classes + 1)
'Compute transition frequencies pij=Nij/Ni
For i = 1 To classes - 1
For j = 1 To classes
If ni(i) > 0 Then pij(i, j) = nij(i, j) / ni(i)
Next j
Next i
'NR category to the end
For i = 1 To classes - 1
If ni(i) > 0 Then pij(i, classes + 1) = nij(i, 0) / ni(i)
Next i
COHORT = pij
I am very new to SQL Server, can anyone help convert this for SQL? I made an attempt based on searching on internet but it didn't come close:
create table trans as
select a.group as from, b.group as to, count(*) as nTrans
from haveRanks as a inner join haveRanks as b
on a.ID=b.ID and a.Date+1 = b.Date
group by a.group, b.group;
create table probs as
select from, to, nTrans/sum(nTrans) as prob
from trans
group by from;
End Function
My data looks something like this:
ID Date Value
1 1/10/14 5
1 5/10/14 5
1 6/23/16 7
2 3/10/00 12
2 6/10/01 4
Edit: Answering Question from Comments:
1) Correct, if a Highest Rating is not supplied, the program will take the maximum number as the "default" class
2) If there is no rating for the year it is has not changed.
3) Not sure I understand this question, the Do While t < yend loops through the observations and checks if the next observations are in the same cohort, or if it's default/Not Rated it will kick out and go to the next one.

Calculate fixed sum of array if some values changed

Say we are given a vector which sums to 1. Assume if values are higher than n, we maximize these to value n, and we want to make the rest of the numbers such that the sum equals 1 again. I.e. the other values need to (potentially) increase.
The other values must increase evenly (by the same factor)
Is there an easy way in excel to do this?
Ex. let n = 0.25
0.077331613 0.077331613
0.237037801 0.237037801
0.341441747 0.25
0.336289699 0.25
0.007899139 0.007899139
The second vector does not sum to 1, and we need to make sure it does without changing elements of value 0.25.
Not sure I agree that the required formulas are "long" and "complicated", nor "calculation intensive" :-).
Assuming your original values are in A2:A6, and your choice of n, e.g. 0.25, in C1, then, in B2:
=IF(A2>=C$1,C$1,A2*(1-C$1*COUNTIF(A$2:A$6,">="&C$1))/SUMIF(A$2:A$6,"<"&C$1))
Copy down to B6.
Regards
I was working on this UDF while the other answer was accepted so I'll post it here for future viewers of this thread.
Tap Alt+F11 then Alt+I, M and paste the following into a module code sheet. Tap Alt+Q to return to your worksheet.
Function udf_vector_elements(rng As Range, elm As Long, n As Double, ttl As Double)
Dim dTTL As Double
Dim v As Long, vELMs As Variant
Dim awf As WorksheetFunction
Dim iSAFETY As Long, iLESS As Long, dFUDGE As Double
Set awf = Application.WorksheetFunction
ReDim vELMs(1 To rng.Cells.Count)
'safety for not enough elements × n < ttl
If rng.Cells.Count * n < ttl Then
udf_vector_elements = "never enough"
Exit Function
End If
'seed the solution array
For v = LBound(vELMs) To UBound(vELMs)
If rng.Cells(v).Value2 < n Then
vELMs(v) = rng.Cells(v).Value2
iLESS = iLESS + 1
Else
vELMs(v) = n
End If
Next v
'safety for sum(elements) > ttl
If awf.Sum(vELMs) > ttl Then
udf_vector_elements = "already too much"
Exit Function
End If
'get to work
Do While Round(awf.Sum(vELMs), 6) < ttl
dFUDGE = (ttl - Round(awf.Sum(vELMs), 6)) / iLESS
iLESS = 0
For v = LBound(vELMs) To UBound(vELMs)
vELMs(v) = Round(awf.Min(vELMs(v) + dFUDGE, n), 6)
iLESS = iLESS - (vELMs(v) <> n)
Next v
Loop
'debug.print
dTTL = awf.Sum(vELMs)
Set awf = Nothing
'return the individual adjusted vector array element
udf_vector_elements = vELMs(elm)
End Function
Use as any other native worksheet function.
=udf_vector_elements(<vector_values>, <element_returned>, <max_n>, <target_total>)
In the below image in C2 as,
=udf_vector_elements(A$2:A$6, ROW(1:1), E$1, 1)
        
Fill down as necessary.

building a 2D array in excel

I'm trying to build an array for a school project, scenario is this:
You have a city that is 30 miles (y) by 20 miles (x) with roads every mile, have to write code that gives the best location for placement of a distribution center based on the business locations and cost to delivery goods to each.
I have one bit of code that records the number of client businesses, an array that records the locations of the businesses, and an array that stores volume of product each client buys.
Where I'm stuck at, is I think I should build an array that is 0 to 30, 0 to 20 (the size of the city) but I have to evaluate the cost based on user defined precision (.25, .5, 1, and 2 miles) so I should have the array be able to store the values from the calculations for 120 by 80 cells.
Not sure if that makes sense, here is the requirements:
Specifically, your program should be able to complete the following tasks:
Read the customer data, and user input for analysis resolution. Your program must be designed to
accommodate changes in the number of customers, their locations, and their product delivery volumes. User options for analysis resolution will be: 0.25 miles, 0.5 miles, 1 mile, and 2 miles.
Validate that user input is numeric and valid.
Analyze the costs at all possible distribution center locations (which may be collocated with customer
locations), and determine the optimums.
Display the X and Y values of the optimum distribution center locations and the corresponding minimum
weekly cost. There may be multiple locations with the same minimum cost.
Display the costs at all locations adjacent to the optimums, in order to show the sensitivity of the result.
The formulas to use are:
Distance to customer (Di)=abs|x-xi|+|y+yi|
Cost for customer (Ci)=1/2*Di*Vi (volume of customer product)* Ft
Ft = 0.03162*y+0.04213*x+0.4462
cost = sum Ci from 1 to number of clients
Below is my code so far, I started it to have it basically build the array and display it on a second sheet, so I can visualize it but I can't have that in the final product. In debugging it, it gets to the line of code di = and gives me a subscript out of range.
Option Explicit
Option Base 1
Sub load()
Dim Cust!, x#, y#, volume#(), n!, loc#(), i%, vol#, xi#, ci#, di#, j#
Dim choices#, val#(), nptsx!, nptsy!, Ft#, lowx!, lowy!, low!, M!
Dim costmatrix#(), npts!, cost!()
'find number of customers
Cust = 0
Do While Cells(8 + Cust, 1).Value <> ""
Cust = Cust + 1
Loop
If Cust < 2 Then
MsgBox "number of customers must be greater than 1."
Exit Sub
End If
'establist array of customer locations
ReDim loc#(1, Cust)
For j = 1 To Cust
x = Cells(7 + j, 2)
y = Cells(7 + j, 3)
Next j
ReDim volume#(Cust, 1)
For i = 1 To Cust
vol = Cells(7 + i, 4)
Next i
choices = Cells(3, 7).Value
nptsx = 30 / choices + 1
nptsy = 20 / choices + 1
'30x20 grid
ReDim costmatrix(x To nptsx, y To nptsy)
For x = 0 To nptsx - 1
Sheet3.Cells(1, x + 2) = x * choices
Next x
For y = 0 To nptsy - 1
Sheet3.Cells(2 + y, 1) = y * choices
Next y
For x = 0 To nptsx - 1
For y = 0 To nptsy - 1
For k = 1 To Cust
di = Abs(x * choices - Sheet1.Cells(7 + j, 2)) + Abs(y * choices - Sheet1.Cells(7 + j, 3))
Ft = 0.03162 * Sheet1.Cells(7 + j, 3) + 0.4213 * Sheet1.Cells(7 + j, 2) + 0.4462
ci = 1 / 2 * di * vol * Ft
Sheet3.Cells(x + 2, 2 + y) = ci
Next k
Next y
Next x
lowx = x
lowy = y
Range("I9:J:3").Clear
Range("I9") = "optimum"
Range("J9") = lowx * choices
Range("K9") = lowy * choices
Range("L9") = low
i = 9
If lowy < npts - 1 Then
i = i + 1
Cells(1, "I") = "Increment North"
Cells(1, "L") = cost(lowx, lowy + 1)
End If
If lowy > 0 Then
i = i + 1
Cells(1, "I") = "Increment South"
Cells(1, "L") = cost(lowx, lowy - 1)
End If
If lowx < npts - 1 Then
i = i + 1
Cells(1, "I") = "Increment East"
Cells(1, "L") = cost(lowx, lowy + 1)
End If
If lowx > 0 Then
i = i + 1
Cells(1, "I") = "Increment West"
Cells(1, "L") = cost(lowx, lowy - 1)
End If
End Sub
Updated, I have built the array, but I need to figure out how to do the calculations for all clients in one cell at a time, adding the results for each client together and putting the sum of them into the cell, then going onto the next cell.
When you dimension loc# via
ReDim loc#(Cust, 2)
The first index must be between 1 and Cust
The you have the loop
For k = 1 To Cust
x = Cells(7 + k, 2)
y = Cells(7 + k, 3)
Next k
After this loop runs k has value Cust + 1, not Cust since for-loops in VBA first increment the counter and then test if it has exceeded the limit.
You don't use k again until the line
di = Abs(Sheet3.Cells(1, x + 2) - loc(k, 1))
At this stage k is Cust + 1 -- which is one more than the highest permissible subscript, hence the subscript out of range error.
In context, I think that you meant to use j rather than k in both that line and the next line. I don't know if your code has other issues, but getting rid of k in those lines should help.

Resources