Fixing the Variance Percentage Program

Okay, the previous VBA function has a few flaws: it doesn’t test for empty cells, and it is rather inefficient when it comes to memory; it stores the results in an array.

For reference, here is the original code:

Public Function LowestCompPer(vRg As Range) As Double
    Dim n As Integer
    Dim t As Integer
    Dim p() As Double
    Dim i As Integer
    Dim wsf As WorksheetFunction
    Dim j As Integer
    Dim k As Integer
    Set wsf = Excel.WorksheetFunction
    n = vRg.Count
    t = (n * (n - 1)) / 2
    ReDim p(t) As Double
    k = 1
    For i = 1 To n - 1
        For j = i + 1 To n
            p(k) = Abs(vRg(i) - vRg(j)) / (wsf.Max(Abs(vRg(i)), Abs(vRg(j))))
            k = k + 1
        Next j
    Next i
    Dim min As Integer
    min = 1
    For i = 1 To t
        If p(i) < p(min) Then
            min = i
        End If
    Next i
    LowestCompPer = p(min)
End Function

Now we’re going to fix this.  Here we go:

Public Function LowestCompPer(vRg As Range) As Double
    Dim i As Integer
    Dim j As Integer
    Dim k As Integer
    Dim FullCells As New Collection
    Dim PerDbl As Double
    Dim min As Double
    'get a count of how many cells aren't empty
    'also keep a collection of cells that aren't empty
    'This will kill two birds with one stone: it will allow us
    'us to get rid of the triangular number calculation,
    'as well as make sure that all cells we're referring to
    'actually have values in them.
    For i = 1 To vRg.Count
        If vRg(i) <> "" Then
            FullCells.Add vRg(i)
        End If
        
    Next i
    'k keeps track of whether or not the first minimum has been calculation.
    '0=no,  1=yes
    k = 0
    For i = 1 To FullCells.Count - 1
        For j = i + 1 To FullCells.Count
            'PerDbl temporarily stores the results of our comparison formula
            PerDbl = Abs(FullCells(i) - FullCells(j)) / _
                (Application.WorksheetFunction.Max(Abs(FullCells(i)), _
                Abs(FullCells(j))))
            'We have to start somewhere.  Remember, all percentages will be 
            'positive
            'Since min always start at 0, we have to initialize min
            'Once we've done that, though, we don't want to change it 
            'again unless we've found a smaller number
            If k = 0 Then
                min = PerDbl
                k = 1
            ElseIf PerDbl < min Then
                min = PerDbl
            End If
        Next j
    Next i
    'Never forget to clean up!
    Set FullCells = Nothing
    LowestCompPer = min
End Function

It may seem strange, but it works.  It may seem like we have traded one inefficiency (looping twice) with another (storing full cells in a Collection), but this was necessary to make sure that the entire range is full.

Leave any comments or questions you may have below.

Variance Problem, Part 2: Electric Boogaloo

To continue from the last post:

Your boss approaches you.  He has a list of 40 SKUs that have been inventoried.  He says, “We need to adjust the inventory on these products.  Each of these SKUs has 4 counts associated with them.  This is represented on this list as the difference between what we actually have and what the computer is telling us we should have.  The only way we can adjust these is if two counts for each product agree with each other within 10%.  Find which ones can be adjusted, and make the appropriate adjustments.”

Here is the table with the SKUs and the four count variances per SKU:

SKU	Var 1	Var 2	Var 3	Var 4
00001	- 42	- 44	- 52	- 42
00002	- 80	-38	- 34	- 93
00007	- 11	+ 2	- 15	- 9
00013	- 85	- 131	- 51	- 74
00020	- 86	- 212	- 83	- 77
00028	- 99	- 202	- 157	- 88
00037	+ 92	+ 16	+ 46	+ 97
00040	+ 91	+ 191	+ 70	+ 82
00050	+ 12	+ 2	+ 18	+ 13
00060	+ 43	+ 48	+ 30	+ 44
00069	+ 31	+ 51	+ 39	+ 34
00074	- 57	- 105	- 70	- 50
00075	- 88	- 31	- 71	- 72
00077	+ 56	+ 104	+ 55	+ 53
00082	+ 68	+ 43	+ 69	+ 73
00090	- 29	- 62	- 26	- 32
00093	- 55	- 73	- 81	- 65
00098	- 34	- 17	- 28	- 32
00108	- 13	- 7	- 18	- 14
00109	- 40	- 7	- 59	- 44
00113	+ 42	- 11	+ 31	+ 39
00117	- 50	- 90	- 65	- 44
00124	- 40	- 92	- 61	- 34
00127	+ 87	- 13	+ 89	+ 97
00135	+ 91	- 10	+ 43	+ 102
00138	- 50	- 42	- 56	- 43
00141	+ 2	+ 0	+ 2	+ 2
00144	- 61	- 19	- 77	- 64
00152	- 5	+ 2	- 6	- 6
00162	+ 30	+ 44	+ 31	+ 28
00169	+ 15	+ 5	+ 22	+ 18
00173	- 66	- 111	- 35	- 58
00179	- 9	- 1	- 5	- 10
00189	- 36	- 2	- 52	- 39
00194	+ 89	+ 219	+ 114	+ 88
00202	- 49	+ 21	- 31	- 55
00212	- 89	- 146	- 95	- 100
00218	- 75	- 105	- 32	- 74
00223	- 78	- 179	- 83	- 63

If you remember the Variance Problem from the last post, you will remember that the formula to get the variance percentage looks a little something like this:

For each of these SKUs, this will have to be done 6 times (again, see the last post to see why).  That means we will have to do this calculation 240 times.  Woof.
Okay, so we do a macro.  We have several choices, here.

1. We could have a macro that goes through each SKU one-by-one, does all of the calculations, and highlights the ones that are good.
2. We could create a user-defined function that we could put into the “F” column to show the lowest variance percentage.

Since I like to show my work, I choose option 2.

First, I save this spreadsheet as an .xlsm file, so it can have macros in it.  Next, I go into the VBA editor (Alt+F11) and this is the formula I put into the editor:

Public Function LowestCompPer(vRg As Range) As Double
    Dim n As Integer
    Dim t As Integer
    Dim p() As Double
    Dim i As Integer
    Dim wsf As WorksheetFunction
    Dim j As Integer
    Dim k As Integer
    Set wsf = Excel.WorksheetFunction
    n = vRg.Count
    t = (n * (n - 1)) / 2
    ReDim p(t) As Double
    k = 1
    For i = 1 To n - 1
        For j = i + 1 To n
            p(k) = Abs(vRg(i) - vRg(j)) / (wsf.Max(Abs(vRg(i)), Abs(vRg(j))))
            k = k + 1
        Next j
    Next i
    Dim min As Integer
    min = 1
    For i = 1 To t
        If p(i) < p(min) Then
            min = i
        End If
    Next i
    LowestCompPer = p(min)
End Function

Here’s how it works.  First, an arbitrary number of cells get passed to the function (you in the back, be quiet—I'm getting to it, I promise). We need to know how many comparisons need to be made (t). Then we need to create a variable that will hold all of the calculations for us. It then goes through all of the necessary combinations and puts two numbers through our variance comparison formula and stores it in the p(k) array. Then, it goes through all of these results stored in the p array and determines the lowest (again, you in the back: BE QUIET) percentages. It then returns the lowest percentage.

What you do is you put the following in the “E” column:

=LowestCompPer(B2:E2)

After autofilling, you get something like this:

SKU	Var 1	Var 2	Var 3	Var 4	Compare Percentage
00001	- 42	- 44	- 52	- 42	0%
00002	- 80	- 38	- 34	- 93	11%
00007	- 11	+ 2	- 15	- 9	18%
00013	- 85	- 131	- 51	- 74	13%
00020	- 86	- 212	- 83	- 77	3%
00028	- 99	- 202	- 157	- 88	11%
00037	+ 92	+ 16	+ 46	+ 97	5%
00040	+ 91	+ 191	+ 70	+ 82	10%
00050	+ 12	+ 2	+ 18	+ 13	8%
00060	+ 43	+ 48	+ 30	+ 44	2%
00069	+ 31	+ 51	+ 39	+ 34	9%
00074	- 57	- 105	- 70	- 50	12%
00075	- 88	- 31	- 71	- 72	1%
00077	+ 56	+ 104	+ 55	+ 53	2%
00082	+ 68	+ 43	+ 69	+ 73	1%
00090	- 29	- 62	- 26	- 32	9%
00093	- 55	- 73	- 81	- 65	10%
00098	- 34	- 17	- 28	- 32	6%
00108	- 13	- 7	- 18	- 14	7%
00109	- 40	- 7	- 59	- 44	9%
00113	+ 42	- 11	+ 31	+ 39	7%
00117	- 50	- 90	- 65	- 44	12%
00124	- 40	- 92	- 61	- 34	15%
00127	+ 87	- 13	+ 89	+ 97	2%
00135	+ 91	- 10	+ 43	+ 102	11%
00138	- 50	- 42	- 56	- 43	2%
00141	+ 2	+ 0	+ 2	+ 2	0%
00144	- 61	- 19	- 77	- 64	5%
00152	- 5	+ 2	- 6	- 6	0%
00162	+ 30	+ 44	+ 31	+ 28	3%
00169	+ 15	+ 5	+ 22	+ 18	17%
00173	- 66	- 111	- 35	- 58	12%
00179	- 9	- 1	- 5	- 10	10%
00189	- 36	- 2	- 52	- 39	8%
00194	+ 89	+ 219	+ 114	+ 88	1%
00202	- 49	+ 21	- 31	- 55	11%
00212	- 89	- 146	- 95	- 100	5%
00218	- 75	- 105	- 32	- 74	1%
00223	- 78	- 179	- 83	- 63	6%

Note here that there are some here that do not fit within the boss's requirements (for example: 00169) because none of the count variances are within 10%. Who did these counts, anyway?

A confession: This is not the optimal solution. The function stores the comparison percentage in an array, and it turns out the array is not necessary. I made this function in the heat of the moment after getting a project at work much like the one referred to here. Also, the function will throw an exception if it encounters an empty cell (since it is intended to be used in a cell, you will get a “#VALUE!” error).

Next, I'm going to show how to fix this to be more efficient and to be able to handle empty cells.