Help needed to find matching string from the collection.

[anish.ms]

Thanks a lot p45cal

[p45cal]

How long is it taking?

[anish.ms]

19 seconds for 500K rows of data

[p45cal]

19 seconds for 500K rows of data

That's more like it.

[anish.ms]

Now I have been asked to test it in a different way.
Instead of first matching the campaign name and then checking for the matching ICD, I need to check each of the ICD in Sh1 with ICD in Sh2 and take the corresponding campaign names from Sh2 as a result.

I think i just need to skip the following step and then change the results to rng2CampaignVals(i2, 1) instead of icd2_Arr(y)

If rng1CampaignVals(i1, 1) = rng2CampaignVals(i2, 1) Then

[p45cal]

You're going to have to explain more how you want to see the results. Best attach a workbook with a small sample of results.
I've attached your workbook, with a couple of new tables, both on the Cohort sheet:
1. A green table at cell H1 which is a full list of all the ICD codes on the Cohort sheet column B, and in the second column, a list of campaign names where that code appears.
2. An orange table at cell E1 where I've taken all the codes from column B of the audit_retail_returned sheet, then looked them up in the green table to give column F.

Is this the sort of thing you're looking for?
(There is no new vba code in the attached.)

ps. I've assumed the ICD codes are case insensitive; eg. N80.9​ is the same as n80.9​

[anish.ms]

Thanks p45cal,
I have attached a sample file with results using the same code with a small modification.
Refer cell U94 - campaignname are duplicating here because of multiple icd matching from the same campaignname. I tried exit for and goto to come out of the loop once a matching icd is found. However, it is not working.
I think cleaning spaces (DelSpaces) will have to be take outside the loop to reduce the running time as it has to check every campaignname in Sh2.

[anish.ms]

I have modified the code to below and seems working fine.

Option Explicit

Sub ICD_Check_V3()
    Dim Sh1    As Worksheet, Sh2 As Worksheet
    Dim Sh1_LR As Long, Sh2_LR As Long, i1 As Long, i2 As Long
    Dim rng1CampaignVals, rng2CampaignVals, rng1ICDVals, rng2ICDVals
    Dim icd1_Arr As Variant, icd2_Arr As Variant
    Dim x      As Long, y As Long, n As Long
    Dim DelSpaces
    Dim rngResults As Range
    
    Application.ScreenUpdating = False
    Application.Calculation = xlManual
    
    DelSpaces = Array(" ", Chr(160), ChrW(8203))
    
    Set Sh1 = Sheets("audit_hospitals_returned")
    Set Sh2 = Sheets("Cohort v2")
    Sh1_LR = Sh1.UsedRange.Rows.Count
    Sh2_LR = Sh2.UsedRange.Rows.Count
    
    Set rngResults = Sh1.Range("U2:U" & Sh1_LR)
    ReDim Results(1 To Sh1_LR - 1, 1 To 1)
    rng1CampaignVals = Sh1.Range("D2:D" & Sh1_LR).Value
    rng1ICDVals = Sh1.Range("S2:S" & Sh1_LR).Value
    rng2CampaignVals = Sh2.Range("B2:B" & Sh2_LR).Value
    rng2ICDVals = Sh2.Range("C2:C" & Sh2_LR).Value
    
    For n = 0 To UBound(DelSpaces)
        Sh1.Range("S2:S" & Sh1_LR).Replace What:=DelSpaces(n), Replacement:="", LookAt:=xlPart, _
                          SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
                          ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
        Sh2.Range("C2:C" & Sh2_LR).Replace What:=DelSpaces(n), Replacement:="", LookAt:=xlPart, _
                          SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
                          ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
    Next n
    
    For i1 = 1 To UBound(rng1CampaignVals)
        If i1 Mod 1000 = 0 Then Application.StatusBar = i1 & " of " & UBound(rng1CampaignVals)
        For i2 = 1 To UBound(rng2CampaignVals)
            icd1_Arr = Split(rng1ICDVals(i1, 1), ",")
            icd2_Arr = Split(rng2ICDVals(i2, 1), ",")
            
            For x = 0 To UBound(icd1_Arr)
                For y = 0 To UBound(icd2_Arr)
                    If UCase(icd1_Arr(x)) = UCase(icd2_Arr(y)) Then
                        If IsEmpty(Results(i1, 1)) Then
                            Results(i1, 1) = rng2CampaignVals(i2, 1)
                        Else
                            Results(i1, 1) = Results(i1, 1) & ", " & rng2CampaignVals(i2, 1)
                        End If
                        GoTo ExitInnerLoop:
                    End If
                Next y
            Next x
ExitInnerLoop:
        Next i2
    Next i1
    rngResults.Value = Results
    
    Erase rng1CampaignVals, rng2CampaignVals, rng1ICDVals, rng2ICDVals, Results
    
    Application.ScreenUpdating = True
    Application.Calculation = xlAutomatic
    
    MsgBox "DONE"
    Application.StatusBar = ""
End Sub

[p45cal]

I think you're jumping out of the loop prematurely and missing many matches.
I haven't time right now to tweak the code but I can look at it much later today (UK time) or tomorrow.

[p45cal]

Try this (no duplicates):

Sub ICD_Check_V4()
Dim Sh1 As Worksheet, Sh2 As Worksheet
Dim Sh1_LR As Long, Sh2_LR As Long, i1 As Long, i2 As Long
Dim rng1CampaignVals, rng2CampaignVals, rng1ICDVals, rng2ICDVals
Dim dict, icd1_Arr, icd2_Arr
Dim x As Long, y As Long, n As Long
Dim DelSpaces
Dim rngResults As Range
    
'Application.ScreenUpdating = False
Application.Calculation = xlManual
    
DelSpaces = Array(" ", Chr(160), ChrW(8203))
    
Set Sh1 = Sheets("audit_hospitals_returned")
Set Sh2 = Sheets("Cohort v2")
Sh1_LR = Sh1.UsedRange.Rows.Count
Sh2_LR = Sh2.UsedRange.Rows.Count
    
Set rngResults = Sh1.Range("U2:U" & Sh1_LR)
ReDim Results(1 To Sh1_LR - 1, 1 To 1)
rng1CampaignVals = Sh1.Range("D2:D" & Sh1_LR).Value
rng1ICDVals = Sh1.Range("S2:S" & Sh1_LR).Value
rng2CampaignVals = Sh2.Range("B2:B" & Sh2_LR).Value
rng2ICDVals = Sh2.Range("C2:C" & Sh2_LR).Value
    
For n = 0 To UBound(DelSpaces)
  Sh1.Range("S2:S" & Sh1_LR).Replace What:=DelSpaces(n), Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
  Sh2.Range("C2:C" & Sh2_LR).Replace What:=DelSpaces(n), Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
Next n
Set dict = CreateObject("Scripting.Dictionary")
For i1 = 1 To UBound(rng1CampaignVals)
  dict.RemoveAll
  If i1 Mod 1000 = 0 Then Application.StatusBar = i1 & " of " & UBound(rng1CampaignVals)
  icd1_Arr = Split(rng1ICDVals(i1, 1), ",")
  For i2 = 1 To UBound(rng2CampaignVals)
    icd2_Arr = Split(rng2ICDVals(i2, 1), ",")
    For x = 0 To UBound(icd1_Arr)
      For y = 0 To UBound(icd2_Arr)
        If UCase(icd1_Arr(x)) = UCase(icd2_Arr(y)) Then
          dict(rng2CampaignVals(i2, 1)) = 0
        End If
      Next y
    Next x
  Next i2
  If dict.Count > 0 Then Results(i1, 1) = Join(dict.keys, ", ")
Next i1
rngResults.Value = Results
    
Erase rng1CampaignVals, rng2CampaignVals, rng1ICDVals, rng2ICDVals, Results
    
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic
    
MsgBox "DONE"
Application.StatusBar = ""
End Sub

[anish.ms]

Thanks a lot p45cal