issue with array duplicates

Question

im trying to create a table with a specific type of object and number of occurrences in my data set. I tried to create 2 sets of arrays to first index the order type, and if the order type is already present in the first array add a 1 to an occurrences array. The issue i am getting is that each row is getting indexed as its own type and returning an occurrence of 1. Here is the code im using

Sub Comparison() 
Dim Sheet As Worksheet
Dim Book As Workbook
Set Book = Excel.ActiveWorkbook
Set Sheet = Book.Sheets("Sheet1")
 
Dim i As Integer
Dim c As Integer 'counter for number of items needed in array
Dim arr() As String 'type of order
Dim occ() As Long
For i = 2 To 31
If Sheet.Cells(i, 3).Value <> "" And Sheet.Cells(i, 2).Value <> "" Then
If isThere(Sheet.Cells(i, 2).Value, arr, c) = -1 Then
c = c + 1
ReDim Preserve arr(1 To c)
arr(c) = Sheet.Cells(i, 2).Value
ReDim Preserve occ(1 To c)
occ(c) = 1
Else
occ(isThere(Sheet.Cells(i, 2).Value, arr, c)) = occ(isThere(Sheet.Cells(i, 2).Value, arr, c)) + 1
End If
End If
Next i

End Sub

Public Function isThere(search As String, arra As Variant, x As Integer) As Long
Dim q
isThere = -1
 
For q = 1 To x
If StrComp(search, arra(q), vbTextCompare) = 0 Then
isThere = q
Exit For
End If
Next q
End Function

Fixed this because i had made a typo in the StrComp() and didn't realize it was always returning -1 — user11765501
– user11765501, Commented Jul 15, 2019 at 15:48

Warcupine · Accepted Answer · 2019-07-15 15:54:10Z

1

Instead of using two arrays you can use one dictionary.

Dictionaries have unique keys and a paired item value, the key will be your cell value, the item will be the occurance.

dim mydict as object
dim i as long
dim myval as variant

set mydict = CreateObject("Scripting.Dictionary") 'If you want to early bind add the reference to microsoft scripting runtime and set mydict to new dictionary

For i = 2 To 31
    myval = .cells(i, 3).value
    'check to see if the key exists
    if mydict.exists(myval) then
         mydict(myval) = mydict(myval) + 1
    else
         mydict.add myval, 1
    end if
next i

answered Jul 15, 2019 at 15:54

Warcupine

4,7203 gold badges18 silver badges27 bronze badges

Sign up to request clarification or add additional context in comments.

Collectives™ on Stack Overflow

issue with array duplicates

1 Answer 1

Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

Comments

Your Answer

Sign up or log in

Post as a guest

Related