Increment different counters depending on array index value

Question

I have a vast list of data in a worksheet (called MainDump). I have a procedure set up to assess this list and return certain values using the following setup:

Dim ws1 As Worksheet
Set ws1 = Worksheets("DashBoard")
Dim ws2 As Worksheet
Set ws2 = Worksheets("MainDump")
Dim cntr As Long

On Error GoTo ErrorHandler 'Got A lot of divide by zero errors if searchstring wasn't found
With Application.WorksheetFunction            
    ws1.Range("O4").Value = .CountIf(ws2.Range("E:E"), "*" & "CEOD" & "*")
    ws1.Range("L4").Value = .CountIfs(ws2.Range("E:E"), "*" & "CEOD" & "*", ws2.Range("A:A"), "Yes") / ws1.Range("O4").Value
    ws1.Range("M4").Value = .CountIfs(ws2.Range("E:E"), "*" & "CEOD" & "*", ws2.Range("B:B"), "Yes") / ws1.Range("O4").Value
    ws1.Range("N4").Value = .CountIfs(ws2.Range("E:E"), "*" & "CEOD" & "*", ws2.Range("C:C"), "SA Present, WBDA Present") / ws1.Range("O4").Value
End With
cntr = cntr + 1        
'^This proces is then copied and thus repeated a total of 76 times, as I want to check 
'for 76 different values in ws2.Range("E:E"), resulting in a massive code

ErrorHandler:
If Err.Number = 6 Then
    If ws1.Range("O" & cntr).Value = 0 Then
        ws1.Range("L" & cntr).Value = "div. by zero"
        ws1.Range("M" & cntr).Value = "div. by zero"
        ws1.Range("N" & cntr).Value = "div. by zero"
    End If
End If
Resume Next

I wrote this when I was a lot less experienced in VBA. Needless to say this code takes a lot of time to complete (Maindump counts about 98000 rows). So I wanted to try do this work via an array.

My approach would be to define a counter for each string I want to check in the array indexes and then looping through the array and increment the corresponding counters when a string is found in the Array. My question is if there is a way to write that loop in the following form:

Dim LastRow1 As long
Dim DataArray() As Variant
Dim SearchString1, SearchString2, .... SearchString76 As String
Dim SearchString1Cntr, SearchString2Cntr, .... SearchString76Cntr As long

With ws2
    LastRow1 = .Cells.Find(What:="*", After:=.Range("A1"), LookAt:=xlPart, LookIn:=xlFormulas, _
        SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row 'Gets the total row amount in the sheet
    DataArray = .Range("A3:E" & LastRow1) 'puts selected range in Array
End With

For LastRow1 = Lbound(DataArray, 1) to Ubound(DataArray, 1)
    'Start a For Each loop to check for all 76 strings
    If Instr(1, DataArray(LastRow1, 5), SearchString > 0 Then 'SearchString is found so then
        SearchStringCntr1 = SearchStringcntr1 + 1 
'Where SearchStrinCntr1 is the counter related to the string checked for in the loop, 
'so it switches when the SearchString changes
    End If
   'Next SearchString to check
Next LastRow1

So I want to try and use a flexible If statement in a For Next loop which checks the Array index for each SearchString and then increments the corresponding SearchStringCntr if the SearchString is found in the index, before looping to the next index. Is this possible? I would like to prevent making 76 different If/ElseIf statements for each SearchString + StringCntr and then use a counter to loop through them every time the code loops through the For LastRow1 / Next LastRow1 loop. Would love to hear your input.

"I would like to prevent making 76 different If/ElseIf statements" <-- IMHO, since declaring 100 int variables vs 1 int array with 100 elements works the same. I suggest to proceed with the 76 if/else statements where the confidence in there. | I normally use excel with concatenate() to produce the case then combine it as a formula/code using notepad++ / notepad. | I personally said this coz it works great for me. ( : — p._phidot_
– p._phidot_, Commented Aug 1, 2018 at 11:54
Why not use a 2 x 76 array for SearchString and SearchStringCntr and loop through that for your search? also, where is DataArray populated and where do you use DataRange? — cybernetic.nomad
– cybernetic.nomad, Commented Aug 1, 2018 at 11:55
@cybernetic.nomad Corrected the code, DataRange was the old name, replaced it with DataArray. the array is populated in the 9th line of the code, filling it with data from the sheet. I didn't think about the 2x76 array solution, I'm gonna go ahead and try that solution. Will update if it works. — Yellow
– Yellow, Commented Aug 1, 2018 at 12:00
Are you just trying to count the occurrences of a string within an array? — ashleedawg
– ashleedawg, Commented Aug 1, 2018 at 12:05
@ashleedawg sorta. I need to know how many occurrences of a string exist in an large data file, which has been loaded into an array. Then using that value I need to make a couple of calculations (see the first code box lines 8-13). And this needs to be done for 76 strings in total. — Yellow
– Yellow, Commented Aug 1, 2018 at 12:10

Sphinx · Accepted Answer · 2018-08-01 12:17:04Z

Maybe this will help (might need some adjustments).
Create named range "Strings" somewhere in your workbook where you'll store all your strings that you're looking for

Option Explicit

Sub StringsCompare()

    Dim LastRow1 As Long
    Dim DataArray() As Variant, StringArray() As Variant
    Dim Ws2 As Worksheet
    Dim CompareStringsNo As Long, StringCounter As Long
    Dim i As Long, j As Long
    Dim aCell As Range
    Dim SourceStr As String, SearchStr As String

    Set Ws2 = ThisWorkbook.Sheets("Sheet1")
    StringCounter = 1

    With Ws2
        'fill array with your strings to compare
        CompareStringsNo = .Range("Strings").Rows.Count
        ReDim StringArray(1 To CompareStringsNo, 1 To 2)
        For Each aCell In .Range("Strings")
            StringArray(StringCounter, 1) = aCell.Value
            StringCounter = StringCounter + 1
        Next aCell

        'fill data array
        LastRow1 = .Cells.Find(What:="*", After:=.Range("A1"), LookAt:=xlPart, LookIn:=xlFormulas, _
            SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row 'Gets the total row amount in the sheet
        DataArray = .Range("A1:E" & LastRow1)
    End With

    'search data array
    For i = LBound(DataArray, 1) To UBound(DataArray, 1)
        SourceStr = DataArray(i, 5)
        'search array with your strings
        For j = LBound(StringArray) To UBound(StringArray)
            SearchStr = StringArray(j, 1)
            If InStr(1, SourceStr, SearchStr) > 0 Then
                'if match is found increase counter in array
                StringArray(j, 2) = StringArray(j, 2) + 1
                'you can add exit for here if you want only first match
            End If
        Next j
    Next i

    For i = LBound(StringArray) To UBound(StringArray)
        Debug.Print StringArray(i, 1) & " - " & StringArray(i, 2)
    Next i

End Sub

Tried it, tweaked it an got it working. Significant speed improvement when comparing to my previous code. All in all precisely what I was looking for :)

ashleedawg · Accepted Answer · 2018-08-01 12:25:33Z

1

I think the main task is being over-complicated.

To check how many times a string occurs within an array you could use a function like this:

Function OccurWithinArray(theArray As Variant, stringToCount As String) As Long
    Dim strArr As String
    strArr = Join(theArray, " ")
    OccurWithinArray = (Len(strArr) - Len(Replace(strArr, stringToCount, _
        vbNullString, , , vbTextCompare))) / Len(stringToCount)
End Function

...and a demonstration:

Sub Demo()
    Dim test(1 To 3) As String
    test(1) = "I work at the Dog Pound."
    test(2) = "I eat dogfish regularly."
    test(3) = "Steroidogenesis is a thing."
    Debug.Print OccurWithinArray(test, "dog")
End Sub

How it works:

Join joins all the elements of the array into one big string. Len returns the length of the text.
Replace temporarily replaces the removes all occurrences of the search term.
Len returns the "modified" length of the text.
The difference between the two Len's, divided by the length of the string being searched for, is the number aof occurrences of the string within the entire array.

This returns 3 since the search is case-insensitive.

To make the search case-sensitive, remove the word vbTextCompare (in which case this example would return 2.)

edited Aug 1, 2018 at 12:25

answered Aug 1, 2018 at 12:18

ashleedawg

21.9k9 gold badges82 silver badges120 bronze badges

2 Comments

Yellow Over a year ago

Definitely seems like a solid approach. I'm gonna and test it. I'm a bit concerned about the length of the string via the Join command. Some strings can occur up to 30.000 times in the MainDump so I'm curious to see the impact on performance. Have to say it is a elegant and intuitive approach ^^

Yellow Over a year ago

Just implemented and tested it. I get an error message : "Run-Time error ' 5': Invalid procedure call or argument" on the line: strArr = Join(theArray, " "). Maybe because DataArray is a 2D array instead of a 1D array?

Collectives™ on Stack Overflow

Increment different counters depending on array index value

2 Answers 2

1 Comment

2 Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

2 Answers 2

1 Comment

2 Comments

Your Answer

Sign up or log in

Post as a guest

Related