Public Sub TestDicFun() Dim WOsDic As Object Set WOsDic = FindWOsDic(ResultsWS) Dim k For Each k In WOsDic.keys Debug.Print k, WOsDic(k) Next k End Sub
Public Function FindWOsDic(ws As Worksheet) As Object Set FindWOsDic = CreateObject("scripting.dictionary") Dim k, tmp As String Set FindWOsTempDic = CreateObject("scripting.dictionary") For Each rcell In WOsRng.Cells tmp = Trim(rcell.Value) If Not FindWOsTempDic.Exists(tmp) Then If Len(tmp) > 0 Then FindWOsTempDic(tmp) = FindWOsTempDic(tmp) + 1 End If Next rcell Set FindWOsDic = FindWOsTempDic End If End Function