Hi all,

Its been a while since i have been on here so VB getting a little rusty, anyway hoping one of you Guys will be able to use your vast knowledge to help me resolve the following.

I have created a spreadsheet to monitor the results of some testing i am doing, however only want to show the Maximum, minimum and average results of those results that have passed. Now as it states in the header i can achieve this via using the following excel formulas on the spreadsheet.

{=IF(MIN(IF($C:$C="PASS",IF($A:$A="VP",$C:$C)))=0, "ND",MIN(IF($C:$C="PASS",IF($A:$A="VP",$C:$C)) ))}

{=IF(MAX(IF($C:$C="PASS",IF($A:$A="VP",$C:$C)))=0, "ND",MAX(IF($C:$C="PASS",IF($A:$A="VP",$C:$C)) ))}

{=IF(MIN(IF($C:$C="PASS",IF($A:$A="VP",$C:$C)))+MA X(IF(IF($C:$C="PASS",IF($A:$A="VP",$C:$C)))=0,"ND" ,AVERAGE(IF($C:$C="PASS",IF($A:$A="VP",$C:$C))))}


ColA ColB ColC
Build Reading Result
VP 6.5 PASS
VP 5.8 PASS
VP 1078 FAIL
VP 260 FAIL
VP 117 FAIL
VP 115 FAIL
VP 224 FAIL
VP 15.2 PASS

The problem is that there are there are many different permatations due to the differing builds as well as the other condition that the test subject can be in (approx 50 permatations in all) so Excel does not have the memory capacity to achieve this, hence the reason i suspect using a dynamic array and VB code would be better as it is hoped that it can do the calculation, populate the spreadsheet with the value, erase the array and move onto the next calculation until all values are in.

Anyway as stated it has been since i played with VB, so in all honesty don't even know were to start, however think once i get sorted with the first set of calculations then i shoul be ok.

Thus any help would be greatly appreciated.

Hi Andrew,

Am Thu, 18 Aug 2016 06:17:15 -0700 (PDT) schrieb
:

ColA ColB ColC
Build Reading Result
VP 6.5 PASS
VP 5.8 PASS
VP 1078 FAIL
VP 260 FAIL
VP 117 FAIL
VP 115 FAIL
VP 224 FAIL
VP 15.2 PASS

the following code writes the expected values in G:N

Sub Test()
Dim LRow As Long, i As Long, j As Long, n As Long
Dim varData As Variant, varOut() As Variant
Dim varBuild As Variant, varResult As Variant
Dim myDic1 As Object, myDic2 As Object

Set myDic1 = CreateObject("Scripting.Dictionary")
Set myDic2 = CreateObject("Scripting.Dictionary")

With Sheets("Sheet1")
LRow = .Cells(Rows.Count, 1).End(xlUp).Row
varData = .Range("A2:C" & LRow)

For i = LBound(varData) To UBound(varData)
myDic1(varData(i, 1)) = varData(i, 1)
myDic2(varData(i, 3)) = varData(i, 3)
Next
varBuild = myDic1.items
varResult = myDic2.items

ReDim Preserve varOut(myDic1.Count * myDic2.Count, 7)
For i = LBound(varBuild) To UBound(varBuild)
For j = LBound(varResult) To UBound(varResult)
varOut(n, 0) = varBuild(i)
varOut(n, 1) = varResult(j)
varOut(n, 2) = "Min:"
varOut(n, 3) = Evaluate("=MIN(IF((A2:A" & LRow & "=""" & varBuild(i) & """)*(C2:C" _
& LRow & "=""" & varResult(j) & """),B2:B" & LRow & "))")
varOut(n, 4) = "Max:"
varOut(n, 5) = Evaluate("=MAX(IF((A2:A" & LRow & "=""" & varBuild(i) & """)*(C2:C" _
& LRow & "=""" & varResult(j) & """),B2:B" & LRow & "))")
varOut(n, 6) = "Avg:"
varOut(n, 7) = Evaluate("=AVERAGE(IF((A2:A" & LRow & "=""" & varBuild(i) & """)*(C2:C" _
& LRow & "=""" & varResult(j) & """),B2:B" & LRow & "))")
n = n + 1
Next
Next
.Range("G1").Resize(UBound(varOut) + 1, 8) = varOut
End With
End Sub


Regards
Claus B.
--
Windows10
Office 2016

Perhaps something less complex and more 'maintenance friendly'...

Sub Test2()
Dim vDataIn, vDataOut(), n&, j&, k&
Dim lRows&, lCols&, s1$

With Sheets("Sheet1")
lRows = .Cells(Rows.Count, 1).End(xlUp).Row
vDataIn = .Range("A2:C" & lRows)
End With 'Sheets("Sheet1")

s1$ = "(IF((A2:A" & lRows & "=""" & vDataIn(n, 1) & """)*(C2:C" _
& lRows & "=""" & vDataIn(n, 3) & """),B2:B" & lRows & "))"
ReDim vDataOut(UBound(vDataIn) * UBound(vDataIn), 8)

For n = LBound(vDataIn) To UBound(vDataIn)
For j = LBound(vDataIn) To UBound(vDataIn)
k = k + 1
vDataOut(k, 1) = vDataIn(n, 1)
vDataOut(k, 2) = vDataIn(n, 3)

vDataOut(k, 3) = "Min"
vDataOut(k, 4) = Evaluate("=MIN" & s1)
vDataOut(k, 5) = "Max"
vDataOut(k, 6) = Evaluate("=MAX" & s1)
vDataOut(k, 7) = "Avg"
vDataOut(k, 8) = Evaluate("=AVERAGE" & s1)
Next 'j
Next 'n
lRows = UBound(vDataOut): lCols = UBound(vDataOut, 2)
Sheets("Sheet1").Range("G1").Resize(lRows, lCols) = vDataOut

End Sub

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

---
This email has been checked for viruses by Avast antivirus software.
https://www.avast.com/antivirus

Hi Andrew,

Am Thu, 18 Aug 2016 06:17:15 -0700 (PDT) schrieb
:

ColA ColB ColC
Build Reading Result
VP 6.5 PASS
VP 5.8 PASS
VP 1078 FAIL
VP 260 FAIL
VP 117 FAIL
VP 115 FAIL
VP 224 FAIL
VP 15.2 PASS

now a version with a better table layout:

Sub Test()
Dim LRow As Long, i As Long, j As Long, n As Long
Dim varData As Variant, varOut() As Variant
Dim varBuild As Variant, varResult As Variant
Dim myDic1 As Object, myDic2 As Object
Dim strFrml As String

Set myDic1 = CreateObject("Scripting.Dictionary")
Set myDic2 = CreateObject("Scripting.Dictionary")

With Sheets("Sheet1")
LRow = .Cells(Rows.Count, 1).End(xlUp).Row
varData = .Range("A2:C" & LRow)

For i = LBound(varData) To UBound(varData)
myDic1(varData(i, 1)) = varData(i, 1)
myDic2(varData(i, 3)) = varData(i, 3)
Next
varBuild = myDic1.items
varResult = myDic2.items

ReDim Preserve varOut(myDic1.Count * myDic2.Count, 4)
varOut(n, 0) = "Build": varOut(n, 1) = "Result": varOut(n, 2) = "Min"
varOut(n, 3) = "Max": varOut(n, 4) = "Average"

For i = LBound(varBuild) To UBound(varBuild)
For j = LBound(varResult) To UBound(varResult)
strFrml = "(IF((A2:A" & LRow & "=""" & varBuild(i) & """)*(C2:C" _
& LRow & "=""" & varResult(j) & """),B2:B" & LRow & "))"
n = n + 1
varOut(n, 0) = varBuild(i)
varOut(n, 1) = varResult(j)
varOut(n, 2) = Evaluate("=MIN" & strFrml)
varOut(n, 3) = Evaluate("=MAX" & strFrml)
varOut(n, 4) = Evaluate("=AVERAGE" & strFrml)
Next
Next
With .Range("G1:K1")
.Font.Bold = True
.HorizontalAlignment = xlCenter
End With
.Range("G1").Resize(UBound(varOut) + 1, 5) = varOut
End With
End Sub

@ Garry:
You can't initialize a string with variables when these are not yet
initialized. You will get a runtime error.The formula string must be
placed into the loop.


Regards
Claus B.
--
Windows10
Office 2016

@ Garry:
You can't initialize a string with variables when these are not yet
initialized. You will get a runtime error.The formula string must be
placed into the loop.

Yes, yes.., nice catch! I pasted in the wrong place...

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

corrected version...

Sub Test2()
Dim vDataIn, vDataOut(), n&, j&, k&
Dim lRows&, lCols&, s1$

With Sheets(2)
lRows = .Cells(Rows.Count, 1).End(xlUp).Row
vDataIn = .Range("A2:C" & lRows)
End With 'Sheets("Sheet1")

ReDim vDataOut(UBound(vDataIn) * UBound(vDataIn), 8)
For n = LBound(vDataIn) To UBound(vDataIn)
s1$ = "(IF((A2:A" & lRows & "=""" & vDataIn(n, 1) & """)*(C2:C" _
& lRows & "=""" & vDataIn(n, 3) & """),B2:B" & lRows & "))"

For j = LBound(vDataIn) To UBound(vDataIn)
k = k + 1
vDataOut(k, 1) = vDataIn(n, 1)
vDataOut(k, 2) = vDataIn(n, 3)

vDataOut(k, 3) = "Min"
vDataOut(k, 4) = Evaluate("=MIN" & s1)
vDataOut(k, 5) = "Max"
vDataOut(k, 6) = Evaluate("=MAX" & s1)
vDataOut(k, 7) = "Avg"
vDataOut(k, 8) = Evaluate("=AVERAGE" & s1)
Next 'j
Next 'n
lRows = UBound(vDataOut): lCols = UBound(vDataOut, 2)
Sheets("Sheet1").Range("G1").Resize(lRows, lCols) = vDataOut

End Sub

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion