CODEWITHSUNDEEP
vbaexcelexcel-2010excel-2007
Sabha
Sabha

Reputation: 619

Avoid elements from an array that does not meet criteria

Ok... The below line puts content of the array myArr in cell A1

sh.Range("A1").Resize(cnt, 7).Value = myArr

Here are some sample records the above line outputs

18  5   1   23  15  7   6
23  5   3   10  18  20  15
19  10  25  12  21  15  23
10  14  11  9   7   25  20
24  15  23  20  11  17  2
7   15  3   16  24  22  13
14  4   15  13  6   23  2
20  11  22  24  14  3   6
17  5   13  15  19  6   22
9   13  15  7   24  3   6

Before this line, I need a condition and not sure how to write the syntax. I want to add up all 7 values of the first element (lbound) and check the sum and do it for all the elements till (ubound). And run the above line only if the total is equal to 100

Once the first query is resolved, I also have a second query to list only the count as to how many elements added up to a total of 100, how many elements had a sum of 80 and so on.... by adding another array that takes info from the first array. The count will be between 75 to 125. The expected output should be

75 1
76 0
77 2
.
.
.
125 1

This is what I am trying

Sub foo()
Dim myArr(1 To 10)
Dim cnt As Integer, i As Integer
myArr(1) = "18,5,1,23,15,7,6"
myArr(2) = "23,5,3,10,18,20,15"
myArr(3) = "19,10,25,12,21,15,23"
myArr(4) = "10,14,11,9,7,25,20"
myArr(5) = "24,15,23,20,11,17,2"
myArr(6) = "7,15,3,16,24,22,13"
myArr(7) = "14,4,15,13,6,23,2"
myArr(8) = "20,11,22,24,14,3,6"
myArr(9) = "17,5,13,15,19,6,22"
myArr(10) = "9,13,15,7,24,3,6"
For i = 1 To UBound(myArr)
With Application.WorksheetFunction.Sum = .Sum(.Index(myArr, i, 0))
    'if ....
        '....
    'endif
End With
Range("A1").Resize(cnt, 7).Value = myArr
End Sub

Upvotes: 0

Views: 69

Answers (1)

QHarr
QHarr

Reputation: 84465

Please see for Part 1 & part 2 following on from chat here:Comments moved to chat This splits your string into its elements, converts to ints and sums. It then performs a check so see if = 100 and if so adds to an array that can then be written out to sheet. I can't help but think there might be a more efficient way then using so many arrays but haven't thought of it yet. 

Sub foo()

Dim myArr(1 To 10)
Dim TotalsArr(1 to 10) 
Dim cnt As Integer, i As Integer

myArr(1) = "18,5,1,23,15,7,6"
myArr(2) = "23,5,3,10,18,20,15"
myArr(3) = "19,10,25,12,21,15,23"
myArr(4) = "10,14,11,9,7,25,20"
myArr(5) = "24,15,23,20,11,17,2"
myArr(6) = "7,15,3,16,24,22,13"
myArr(7) = "14,4,15,13,6,23,2"
myArr(8) = "20,11,22,24,14,3,6"
myArr(9) = "17,5,13,15,19,6,22"
myArr(10) = "9,13,15,7,24,3,6"

Dim tempArr as Variant
Dim Val as Variant
Dim Total as Long
Dim Counter As Long
Dim FinalArr()

Part 1: Calculating the item totals and checking if =100, then add to result Array.

Counter = 0
For i = LBound(myArr) to UBound(myArr)
    Total = 0
    tempArr = Split(myArr(i),",")

    For Each Val in tempArr
        Total = Total + Val
    Next Val
    If Total = 100 Then
        ReDim Preserve FinalArr(Counter)
        FinalArr(Counter) = myArr(i)
        Counter = Counter + 1
    End If

    TotalsArr(i) = Total 'store totals for later use in dictionary
Next i    

For i = LBound(FinalArr) to UBound(FinalArr)
    Debug.Print FinalArr(i)
Next i

Part 2: Getting a count of each distinct total. We will use a dictionary to store the count of each key (total) and overwrite when the same key is found again adding one to the value (i.e. count)

Dim totalsDict As Scripting.Dictionary 'Tools > references > add in microsoft scripting runtime
Dim key as Variant

Set totalsDict = New Scripting.Dictionary

'If prepopulating with totals to check for in range 75 to 125 ( otherwise comment out next 3 code lines

For i = 75 to 125
    totalsdict.Add i , 0
Next i

For i = LBound(TotalsArr) to UBound(TotalsArr)
        totalsDict(TotalsArr(i)) = totalsDict(TotalsArr(i)) + 1 'will overwrite adding one to value
Next i

For Each key in totalsdict.Keys
    Debug.print key, "," , totalsDict(key)
Next key

End Sub

Upvotes: 1

Related Questions