Count string within string using VBA

Question

I have product codes: (they are in C column of active sheet)

DO-001
DO-002
DO-003
DO-004

And I have big list of data: (they are in C column of "Sheet1")

41300100_DO-001_14215171
41300104_DO-001_14215173
K1_ISK_41300661_DO-002_13190369
NP_41533258_DO-003_14910884
DO-003_DD_44_ddd

And I want to count how many times do the product codes appear in the list of data. So the result for this case'd be: (result is H column of active sheet)

DO-001   2
DO-002   1
DO-003   2
DO-004

I have done this with this code:

Sub CountcodesPLC()
    Dim i, j As Integer, icount As Integer
    Dim ldata, lcodes As Long

    icount = 0

    lcodes = Cells(Rows.Count, 3).End(xlUp).Row
    ldata = Worksheets("Sheet1").Cells(Rows.Count, 3).End(xlUp).Row

    For i = 10 To lcodes
        For j = 2 To ldata
            If InStr(Worksheets("Sheet1").Range("C" & j), Range("C" & i)) <> 0 Then
                icount = icount + 1
            End If
        Next j

        If icount <> 0 Then
            Range("H" & i).Value = icount
        End If

       icount = 0
    Next i
End Sub

But I want to change it, so if the list of data contains some key words like "NP", "ISK", then not to count them, or if the first part of the data is the code then also not to count them, so the result for this example would be:

DO-001   2
DO-002 
DO-003 
DO-004

Also, I'll have around 1.000 product codes, and around 60.000 strings of data. Will my code crash?

"*Will my code crash?*": Really? Is this the sixty-four-thousand-dollar question? Why just don't you backup your file and run the code and see what happens? Just to say: Code review questions are meant to be off-topic here. You need to ask a *specific* question to an issue you have with your code (see [ask]). — Pᴇʜ, Jun 14 '17 at 07:21
Side note: (1) If you declare `Dim ldata, lcodes As Long` then only the last variable is of type `Long` the first remains `Variant`. You need to specify a type for **every** variable like `Dim ldata As Long, lcodes As Long`. (2) Never use `Integer` unless you communicate with old APIs. Always use `Long` instead, especially for row counts, because Excel has more rows than `Integer` can handle. Read [here](https://stackoverflow.com/a/26409520/3219613) for some background about Integer and Long. — Pᴇʜ, Jun 14 '17 at 07:21

score 0 · Answer 1 · answered Jun 14 '17 at 07:09

Seems your code is OK. But if you want to match only the first part of string (a'ka StartsWith), i'd change only this line:

If InStr(Worksheets("Sheet1").Range("C" & j), Range("C" & i)) <> 0 Then

to:

If Worksheets("Sheet1").Range("C" & j) Like Range("C" & i) & "*" Then

For further details, please see: Wildcard Characters used in String Comparisons

score 0 · Answer 2 · edited Jun 14 '17 at 07:17

0

Use Dictionnary

Dim Dict As Scripting.Dictionary
Set Dict = New Scripting.Dictionary

Arr = Split("refer your text here", "_")

For I = LBound(Arr) To UBound(Arr)
    If Dict.Exists(Arr(I)) Then
        Dict(Arr(I)) = Dict(Arr(I)) + 1 'increment
    Else
        Dict.Add Arr(I), 1
    End If
Next I

edited Jun 14 '17 at 07:17

Pᴇʜ

56,719
10
49
73

answered Jun 14 '17 at 07:11

score 0 · Answer 3 · answered Jun 14 '17 at 08:05

This may be OTT for the requirement but should work quite quickly.

Public Sub Sample()
Dim WkSht       As Worksheet
Dim LngRow      As Long
Dim AryLookup() As String
Dim VntItem     As Variant

'We put what we want to search into an array, this makes it a lot quicker to search
Set WkSht = ThisWorkbook.Worksheets("Sheet1")
    ReDim AryLookup(0)
    LngRow = 1
    Do Until WkSht.Range("A" & LngRow) = ""
        If AryLookup(UBound(AryLookup, 1)) <> "" Then ReDim Preserve AryLookup(UBound(AryLookup, 1) + 1)
        AryLookup(UBound(AryLookup, 1)) = Trim(UCase(WkSht.Range("A" & LngRow)))
        LngRow = LngRow + 1
    Loop
Set WkSht = Nothing

'Then we go down the list and check the array against each item
Set WkSht = ActiveSheet
    LngRow = 1
    Do Until WkSht.Range("A" & LngRow) = ""
        WkSht.Range("B" & LngRow) = 0
        For Each VntItem In AryLookup()

            'This looks for the match without any of the exclusion items
            If (InStr(1, VntItem, Trim(UCase(WkSht.Range("A" & LngRow)))) <> 0) And _
                (InStr(1, VntItem, "NP") = 0) And _
                (InStr(1, VntItem, "ISK") = 0) Then
                WkSht.Range("B" & LngRow) = WkSht.Range("B" & LngRow) + 1
            End If
        Next
        LngRow = LngRow + 1
    Loop
Set WkSht = Nothing

MsgBox "Done"

End Sub

Basically, the 60,000 data strings will go into an array in memory, then the array will be searched against the 1,000 products. Searching in memory should be quick.

One thing I would raise is the exclusion method may produce false positives.

For example, excluding NP will exclude: -

NP_41533258_DO-003_14910884

NPA_41533258_DO-003_14910884

41533258_ANP_DO-003_14910884

You may want to think about the method overall.

Thanks, this works well for me. Yes, I knew about NP, NPA thing. It's OK for this version. I will just try to edit it, so if the code is first part of the string, then not to count them. And also if the count is zero, then to left blank. — user155754, Jun 14 '17 at 10:08
Also, when I try to add more keywords like "NP" it still counts them. — user155754, Jun 14 '17 at 10:21
you need to add a line in the `if` statement after the NP line `(InStr(1, VntItem, "NewValue") = 0) And _`. — Gary Evans, Jun 14 '17 at 10:56

score 0 · Answer 4 · answered Jun 14 '17 at 08:23

Have you considered an array formula, not sure how it will perform vs code, but, you could do something along these lines, where list is in A and prod numbers in B

=SUM(IF(NOT(ISERR(SEARCH(B1 & "_",$A$1:$A$5,1)))*(ISERR(SEARCH("NP_",$A$1:$A$5,1))),1,0))

Where "NP" would be replaced by a range containing the exclusions, I've left as NP to show what's happening.

Dy.Lee · Answer 5 · 2017-06-14T15:28:37.940

The code would be like this. But I don't know the speed.

Sub test()
    Dim vDB, vLook, vSum(), Sum As Long
    Dim Ws As Worksheet, dbWs As Worksheet
    Dim s As String, sF As String, sCode As String
    Dim i As Long, j As Long, n As Long

    Set dbWs = Sheets("Sheet1")
    Set Ws = ActiveSheet

    With Ws
        vLook = .Range("a1", .Range("a" & Rows.Count).End(xlUp))
    End With
    With dbWs
        vDB = .Range("c1", .Range("c" & Rows.Count).End(xlUp))
    End With

    n = UBound(vLook, 1)

    ReDim vSum(1 To n, 1 To 1)
    For i = 1 To n
        sF = Split(vLook(i, 1), "-")(0)
        sCode = Replace(vLook(i, 1), sF, "")
        Sum = 0
        For j = 1 To UBound(vDB, 1)
            s = vDB(j, 1)
            If Left(s, Len(sF)) = sF Or InStr(s, "NP") Or InStr(s, "ISK") Then
            Else
                If InStr(s, sCode) Then
                    Sum = Sum + 1
                End If
            End If
        Next j
        If Sum > 0 Then
            vSum(i, 1) = Sum
        End If
    Next i
    Ws.Range("h1").Resize(n) = vSum

End Sub

Count string within string using VBA

5 Answers5