VBA with Arrays. Need help quickly.
Start out with a column of randomly generated numbers. There should be 300 numbers in the column. You will need at least 4 arrays in your program, each holding 300 values.
1. Bring the values that you generated in the first column in your spreadsheet into an array named FirstCol.
2.Convert the values into integers and save them into an array named SecondCol.
3. Loop through the values in SecondCol.
a)If the value is less than 10 put that value in an array named Less10.
b)If a value is equal to or greater than 10 but less than 20 put that value into an array named LessTwenty
c) All other values put in an array named MoreTwenty.
4. For each of the 3 arrays just generated, calculate the number of values in the array, the average of all the values in the array, the minimum value in the array, and the maximum value in the array. You should be able to do the last 3 tasks in one loop through the array.
5. For each of the three arrays generated in step 4, count the number of values in the array that are less than the average value you just found.
6.For each of the 3 arrays generated in step 4, display on the worksheet the number of values in the array, the average, the minimum, the maximum, and the number of values that are less than average.
Any help is appreciated. I cannot figure this code out for some reason.
Here you have the code you need.
I think that you must have this project to do as academic experience, but anyway I did it! I hope you look trough it and learn and not just send to your teacher.
Sub Project()
Dim FirstCol()
Dim SecondCol()
Dim x As Variant
Dim LessTen()
Dim LessTwenty()
Dim MoreTwenty()
Dim i As Integer
Dim j As Integer
Dim h As Integer
Dim nLessTen As Integer
Dim nLessTwenty As Integer
Dim nMoreTwenty As Integer
Dim LessTentotal As Double
Dim LessTenaverage As Double
Dim minLessTen As Double
Dim maxLessTen As Double
Dim LessTwentytotal As Double
Dim LessTwentyaverage As Double
Dim minLessTwenty As Double
Dim maxLessTwenty As Double
Dim MoreTwentytotal As Double
Dim MoreTwentyaverage As Double
Dim minMoreTwenty As Double
Dim maxMoreTwenty As Double
Dim LessThanAverageLessTen()
Dim LessThanAverageLessTwenty()
Dim LessThanAverageMoreTwenty()
Dim c1, c2, c As Integer
'generate the random numbers
Range("a1").FormulaR1C1 = "=Randbetween(1,100)"
Range("a1").Copy
Range("a1:a300").PasteSpecial xlPasteFormulas
Range("a1:a300").Copy
Range("a1:a300").PasteSpecial xlPasteValues
'create FirstCol array
ReDim FirstCol(1 To ActiveSheet.Range("A1:A300").Rows.Count, 1 To ActiveSheet.Range("A1:A300").Columns.Count)
FirstCol = Range("A1:A300")
'convert numbers into integers
Range("B1").Select
ActiveCell.FormulaR1C1 = "=ROUND(RC[-1],0)"
Selection.AutoFill Destination:=ActiveCell.Range("A1:A11"), Type:=xlFillDefault
Selection.AutoFill Destination:=ActiveCell.Range("A1:A300"), Type:=xlFillDefault
'create SecondCol array
ReDim SecondCol(1 To ActiveSheet.Range("B1:B300").Rows.Count, 1 To ActiveSheet.Range("B1:B300").Columns.Count)
SecondCol = Range("B1:B300")
'loop through the values
i = 0
j = 0
h = 0
For Each x In SecondCol
Select Case x
Case 0 To 9
i = i + 1
ReDim Preserve LessTen(i)
LessTen(i) = x
Case 10 To 19
j = j + 1
ReDim Preserve LessTwenty(j)
LessTwenty(j) = x
Case Is >= 20
h = h + 1
ReDim Preserve MoreTwenty(h)
MoreTwenty(h) = x
End Select
Next x
'number of values in each array
nLessTen = UBound(LessTen)
nLessTwenty = UBound(LessTwenty)
nMoreTwenty = UBound(MoreTwenty)
'average, min and max in each array
minLessTen = 1E+61
LessTentotal = 0
maxLessTen = 0
For i = 1 To UBound(LessTen)
LessTentotal = LessTentotal + LessTen(i)
LessTenaverage = LessTentotal / UBound(LessTen)
If maxLessTen < LessTen(i) Then
maxLessTen = LessTen(i)
End If
If minLessTen > LessTen(i) Then
minLessTen = LessTen(i)
End If
Next i
minLessTwenty = 1E+61
LessTwentytotal = 0
maxLessTwenty = 0
For i = 1 To UBound(LessTwenty)
LessTwentytotal = LessTwentytotal + LessTwenty(i)
LessTwentyaverage = LessTwentytotal / UBound(LessTwenty)
If maxLessTwenty < LessTwenty(i) Then
maxLessTwenty = LessTwenty(i)
End If
If minLessTwenty > LessTwenty(i) Then
minLessTwenty = LessTwenty(i)
End If
Next i
minMoreTwenty = 1E+61
MoreTwentytotal = 0
maxMoreTwenty = 0
For i = 1 To UBound(MoreTwenty)
MoreTwentytotal = MoreTwentytotal + MoreTwenty(i)
MoreTwentyaverage = MoreTwentytotal / UBound(MoreTwenty)
If maxMoreTwenty < MoreTwenty(i) Then
maxMoreTwenty = MoreTwenty(i)
End If
If minMoreTwenty > MoreTwenty(i) Then
minMoreTwenty = MoreTwenty(i)
End If
Next i
'create new arrays to store the numbers lower than the average
j = 0
For i = 1 To UBound(LessTen)
If LessTen(i) < LessTenaverage Then
j = j + 1
ReDim Preserve LessThanAverageLessTen(j)
LessThanAverageLessTen(j) = LessTen(i)
End If
Next i
j = 0
For i = 1 To UBound(LessTwenty)
If LessTwenty(i) < LessTwentyaverage Then
j = j + 1
ReDim Preserve LessThanAverageLessTwenty(j)
LessThanAverageLessTwenty(j) = LessTwenty(i)
End If
Next i
j = 0
For i = 1 To UBound(MoreTwenty)
If MoreTwenty(i) < MoreTwentyaverage Then
j = j + 1
ReDim Preserve LessThanAverageMoreTwenty(j)
LessThanAverageMoreTwenty(j) = MoreTwenty(i)
End If
Next i
'count the number less than the average for each array
c = UBound(LessThanAverageMoreTwenty)
c1 = UBound(LessThanAverageLessTwenty)
c2 = UBound(LessThanAverageLessTen)
'Display on worksheet the requirements of question number 5.
Columns("E:K").AutoFit
Range("E2") = "LessTen"
Range("e3") = "LessTwenty"
Range("e4") = "MoreTwenty"
Range("f1") = "Number of elements in each array"
Range("F2") = nLessTen
Range("F3") = nLessTwenty
Range("F4") = nMoreTwenty
Range("g1") = "Average of each array"
Range("g2") = LessTenaverage
Range("g3") = LessTwentyaverage
Range("g4") = MoreTwentyaverage
Range("h1") = "Minimum of each array"
Range("h2") = LessTenaverage
Range("h3") = LessTwentyaverage
Range("h4") = MoreTwentyaverage
Range("i1") = "Maximum of each array"
Range("i2") = maxLessTen
Range("i3") = maxLessTwenty
Range("i4") = maxMoreTwenty
End Sub
I hope it helps!
kisses
Cátia Santos