Redundancy in logic for excel VBA - excel

Question

Please see the image attached -
My requirement is -
"If status null and Ref No. not unique then
check value2. If value2 not present, check value1 and take average
Example: For ref number = 1, calculated value is (50+10)/2 = 30 "
"if status is selected or Ref no is unique then
copy from value2, if not present then copy from value1
Example: For Ref No 3, value is 100 and for Ref No 4, value is 20
Total value= 100+30+20 = 150
My attempt
For I = 2 To lrow 'sheets all have headers that are 2 rows
'unique
If Application.WorksheetFunction.CountIf(ws.Range("A" & fRow, "A" & lrow), ws.Range("A" & I)) = 1 Then
If (ws.Range("AW" & I) <> "") Then 'AW has value2
calc = calc + ws.Range("AW" & I).Value
Else: calc = calc + ws.Range("AV" & I).Value 'AV has value1
End If
'not unique
Else
'selected
If ws.Range("AY" & I) = "Selected" Then 'AY has status (Selected/Null)
If (ws.Range("AW" & I) <> "") Then
calc = calc + ws.Range("AW" & I).Value
Else: calc = calc + ws.Range("AV" & I).Value
End If
'not selected
Else
If (ws.Range("AW" & I) <> "") Then
calc1 = calc1 + ws.Range("AW" & I).Value
Else: calc1 = calc1 + ws.Range("AV" & I).Value
End If
calc1 = calc1/Application.WorksheetFunction.CountIf(ws.Range("A" & fRow, "A" & lrow), ws.Range("A" & I))
End If
End If
My problem is -
Getting the Ref No 3 twice in my logic.
Not able to calculate the correct average.
How can I get the correct output? Thanks.

Answer 1

Using a SQL statement against the worksheet
If I understand your requirements, they are as follows:
For each Ref no, you want
the average of
value2 if it exists, otherwise value1
where the status is selected, or
there is no status = selected for this Ref no
I would open an ADODB Recordset against the data, with the following SQL:
SELECT [Ref no], Avg(Iif(value2 IS NOT NULL, value2, value1)) AS Result
FROM Sheet1
LEFT JOIN (
SELECT DISTINCT [Ref No]
FROM Sheet1
WHERE status = "selected"
) t1 ON Sheet1.[Ref no] = t1.[Ref no]
WHERE Sheet1.status="selected" OR t1.[Ref no] IS NULL
GROUP BY [Ref no]
Using nested Scripting.Dictionary
If SQL is not your thing, then you could something like the following:
'Define names for the columns; much easier to read row(RefNo) then arr(0)
Const refNo = 1
Const status = 3
Const value1 = 5
Const value2 = 6
'For each RefNo, we have to store 3 pieces of information:
' whether any of the rows are selected
' the sum of the values
' the count of the values
Dim aggregates As New Scripting.Dictionary
Dim arr() As Variant
arr = Sheet1.UsedRange.Value
Dim maxRow As Long
maxRow = UBound(arr, 1)
Dim i As Long
For i = 2 To maxRow 'exclude the column headers in the first row
Dim row() As Variant
row = GetRow(arr, i)
'Get the current value of the row
Dim currentValue As Integer
currentValue = row(value1)
If row(value2) <> Empty Then currentValue = row(value2)
'Ensures the dictionary always has a record corresponding to the RefNo
If Not aggregates.Exists(row(refNo)) Then Set aggregates(row(refNo)) = InitDictionary
Dim hasPreviousSelected As Boolean
hasPreviousSelected = aggregates(row(refNo))("selected")
If row(status) = "selected" Then
If Not hasPreviousSelected Then
'throw away any previous sum and count; they are from unselected rows
Set aggregates(row(refNo)) = InitDictionary(True)
End If
End If
'only include currently seleced refNos, or refNos which weren't previously selected,
If row(status) = "selected" Or Not hasPreviousSelected Then
aggregates(row(refNo))("sum") = aggregates(row(refNo))("sum") + currentValue
aggregates(row(refNo))("count") = aggregates(row(refNo))("count") + 1
End If
Next
Dim key As Variant
For Each key In aggregates
Debug.Print key, aggregates(key)("sum") / aggregates(key)("count")
Next
with the following two helper functions:
Function GetRow(arr() As Variant, rowIndex As Long) As Variant()
Dim ret() As Variant
Dim lowerbound As Long, upperbound As Long
lowerbound = LBound(arr, 2)
upperbound = UBound(arr, 2)
ReDim ret(1 To UBound(arr, 2))
Dim i As Long
For i = lowerbound To upperbound
ret(i) = arr(rowIndex, i)
Next
GetRow = ret
End Function
Function InitDictionary(Optional selected As Boolean = False) As Scripting.Dictionary
Set InitDictionary = New Scripting.Dictionary
InitDictionary.Add "selected", selected
InitDictionary.Add "sum", 0
InitDictionary.Add "count", 0
End Function
Explanation of SQL
For each Ref no, you want
Group the records by Ref no, using the GROUP BY clause
the average of
We'll return both the Ref no and the average -- SELECT [Ref no], Avg(...)
value2 if it exists, otherwise value1
Iif(value2 IS NOT NULL, value2, value1)
where the status is selected, or
WHERE Sheet1.status="selected" OR
there is no status = selected for this Ref no
We get a list of (unique -- DISTINCT) Ref nos that have status = "selected":
SELECT DISTINCT [Ref No]
FROM Sheet1
WHERE status = "selected"
and give it a name (AS t1) so we can refer to it separately from the main list (Sheet1)
Then we connect, or join (JOIN) that sublist to the main list, where the [Ref no] is the same in both (ON Sheet1.[Ref no] = t1.[Ref no]).
A simple JOIN is an INNER JOIN, where the records on both sides of the connection have to match. What we want in this case, is the records on the main list which do not match the records in the sublist. In order to see such records, we can use a LEFT JOIN, which displays all the records on the left side, and only those records on the right side that match.
We can then filter out the records that do match, using OR t1.[Ref no] IS NULL.

Answer 2

There must be a more concise way, but I think this does what you want. It is based on your example, so data in A1:F6 so will need amending.
Sub x()
Dim v2() As Variant, v1, i As Long, n As Long, d As Double
v1 = Sheet1.Range("A1:F6").Value
ReDim v2(1 To UBound(v1, 1), 1 To 5) 'ref/count/null/value null/value selected
With CreateObject("Scripting.Dictionary")
For i = 2 To UBound(v1, 1)
If Not .Exists(v1(i, 1)) Then
n = n + 1
v2(n, 1) = v1(i, 1)
v2(n, 2) = v2(n, 2) + 1
If v1(i, 3) = "" Then
v2(n, 3) = v2(n, 3) + 1
v2(n, 4) = IIf(v1(i, 6) = "", v1(i, 5), v1(i, 6))
ElseIf v1(i, 3) = "selected" Then
v2(n, 5) = IIf(v1(i, 6) = "", v1(i, 5), v1(i, 6))
End If
.Add v1(i, 1), n
ElseIf .Exists(v1(i, 1)) Then
v2(.Item(v1(i, 1)), 2) = v2(.Item(v1(i, 1)), 2) + 1
If v1(i, 3) = "" Then
v2(.Item(v1(i, 1)), 3) = v2(.Item(v1(i, 1)), 3) + 1
If v1(i, 6) = "" Then
v2(.Item(v1(i, 1)), 4) = v2(.Item(v1(i, 1)), 4) + v1(i, 5)
Else
v2(.Item(v1(i, 1)), 4) = v2(.Item(v1(i, 1)), 4) + v1(i, 6)
End If
Else
If v1(i, 6) = "" Then
v2(.Item(v1(i, 1)), 5) = v2(.Item(v1(i, 1)), 5) + v1(i, 5)
Else
v2(.Item(v1(i, 1)), 5) = v2(.Item(v1(i, 1)), 5) + v1(i, 6)
End If
End If
End If
Next i
End With
For i = LBound(v2, 1) To UBound(v2, 1)
If v2(i, 2) > 1 And v2(i, 3) = v2(i, 2) Then
d = d + v2(i, 4) / v2(i, 2)
End If
If v2(i, 2) > 1 And v2(i, 3) < v2(i, 2) Then
d = d + v2(i, 5) / (v2(i, 2) - v2(i, 3))
End If
If v2(i, 2) = 1 And v2(i, 3) = v2(i, 2) Then
d = d + v2(i, 4) / v2(i, 2)
End If
Next i
MsgBox "Total = " & d
End Sub