Vba - count string within string

[beruf3]

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 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 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?

 

[Akuini]

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.

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

Questions:
1. Is the code has same pattern i.e 'DO-' followed by 3 numbers?
2. The product codes in active sheet is sorted, right?
3. Is the data in the big list somehow also 'sorted by the code'? I mean, say, if cell C3 has 'DO-002' in it then you won't find below C3 a cell that has 'DO-001' in it.

 

[beruf3]

1. Yes
2. Yes
3. No, it can't be sorted, because code is, most of the times, in the middle of the string.

 

[Akuini]

1. Yes
2. Yes
3. No, it can't be sorted, because code is, most of the times, in the middle of the string.

Ok, one more question:
Is the big list unique or there are some duplicate?

 

[beruf3]

It's unique.

 

[Akuini]

It's unique.

Ok, try this:
Assuming the data start at C2 in both sheets:

Sub a1009621()
'https://www.mrexcel.com/forum/excel-questions/1009621-visual-basic-applications-count-string-within-string.html
Dim i As Long, k As Long
Dim d As Object
Dim ws1 As Worksheet
Dim va, vb, vc, vd, x, t

t = Timer
Set ws1 = Sheets("Sheet1")

va = Range("C2", Cells(Rows.count, "C").End(xlUp)).Value
vb = ws1.Range("C2", ws1.Cells(Rows.count, "C").End(xlUp)).Value
ReDim vc(1 To UBound(vb, 1), 1 To 1)
ReDim vd(1 To UBound(va, 1), 1 To 1)

For i = 1 To UBound(vb, 1)
    If InStr(vb(i, 1), "NP") Or InStr(vb(i, 1), "ISK") Or Left(vb(i, 1), 3) = "DO-" Then
    'do nothing
    Else
    k = k + 1
    vc(k, 1) = vb(i, 1)
    End If
Next

    Set d = CreateObject("scripting.dictionary")
    d.CompareMode = vbBinaryCompare

    For i = 1 To k
          d(vc(i, 1)) = 1
    Next

For i = 1 To UBound(va, 1)
vd(i, 1) = 0
    For Each x In d
        If InStr(x, va(i, 1)) Then
        vd(i, 1) = vd(i, 1) + 1
        d.Remove x
        End If
        
    Next
Next
Range("H2").Resize(UBound(vd, 1), 1) = vd

    MsgBox "It's done in " & Timer - t & " seconds"
    
End Sub

 

[beruf3]

Thanks!
Your code works!
Only, when I put in compiler, I can only run it from there.
When I try to run it from Excel Macros it only blinks "Create".

 

[Akuini]

Thanks!
Your code works!
Only, when I put in compiler, I can only run it from there.
When I try to run it from Excel Macros it only blinks "Create".

I just realized that. It has something to do with the sub name, maybe because the last character is number.
Just change the sub name 'Sub a1009621()' to 'Sub a1009621a()' or anything else you want.

 

[beruf3]

Yes, I also figured that out, thanks!

 

[beruf3]

Also,because I have like 8 different product codes "DO-", "CI-", "CA-",...
Can I change the part of code

[COLOR=#333333]Left([/COLOR]<acronym title="vBulletin" style="color: rgb(51, 51, 51); font-size: 12px; border-width: 0px 0px 1px; border-top-style: initial; border-right-style: initial; border-bottom-style: dotted; border-left-style: initial; border-top-color: initial; border-right-color: initial; border-bottom-color: rgb(0, 0, 0); border-left-color: initial; border-image: initial; cursor: help;">vb</acronym>[COLOR=#333333](i, 1), 3) = "DO-" Then

to

[/COLOR]

[COLOR=#333333]Left([/COLOR]<acronym title="vBulletin" style="color: rgb(51, 51, 51); font-size: 12px; border-width: 0px 0px 1px; border-top-style: initial; border-right-style: initial; border-bottom-style: dotted; border-left-style: initial; border-top-color: initial; border-right-color: initial; border-bottom-color: rgb(0, 0, 0); border-left-color: initial; border-image: initial; cursor: help;">vb</acronym>[COLOR=#333333](i, 1), 3) = Left(va(i,1),3) Then[/COLOR]

And I want, if the count is zero, to left it blank ("").
Is that like this:

If vd > 0
Range("H2").Resize(UBound(vd, 1), 1) = vd