WorksheetFunction.countif criteria not working

[mecerrato]

I am using the following code to create an email list of unique emails. The list has a lot of duplicates, but I only want them once. Some of the rows have not been assigned an email so they show as "UNASSIGNED" <unassigned>and I want to ignore those.


I have used this in another sheet where it is working well, the difference is that on this new application I need to copy the data to a temporary location, because it is filtered and the CountIf does not work on filtered rows.


The code is suppose to ignore the criteria for the text "UNASSIGNED"<unassigned>.


I first use the CountIf to get the loan officer email list (MLO list). That works fine I then have code to get the Processor list that has some rows with word "UNASSIGNED", this is not working as it should. The code below Processor list is supposed to ignore any value that equals "UNASSIGNED"<unassigned>, but it doesn't:

Sheets(2).Cells.ClearContents
  lastSrcRw = Sheets("Pipeline").Cells(Rows.Count, 2).End(xlUp).Row
     For Each cell In Sheets("Pipeline").Range("E11:E" & lastSrcRw).SpecialCells(xlCellTypeVisible)
        dstRw = dstRw + 1
        cell.Copy Sheets(2).Range("A" & dstRw)
     Next


'Loop through Sheet2 list, extract unique addresses
  lastTmpRw = Sheets(2).Cells(Rows.Count, 1).End(xlUp).Row
     For tmpRw = 1 To lastTmpRw
         If WorksheetFunction.CountIf(Sheets(2).Range("A1:A" & tmpRw), _
            Sheets(2).Range("A" & tmpRw)) < 2 Then
               addylist_tmp = addylist_tmp & Sheets(2).Range("A" & tmpRw).Value & "; "
         End If
     Next tmpRw


'Clean up temp addylist
     addylist = Left(addylist_tmp, Len(addylist_tmp) - 2)
     'MsgBox addylist


'Processor List
Sheets(2).Cells.ClearContents
  lastSrcRw = Sheets("Pipeline").Cells(Rows.Count, 4).End(xlUp).Row
     For Each cell In Sheets("Pipeline").Range("C11:C" & lastSrcRw).SpecialCells(xlCellTypeVisible)
        dstRw = dstRw + 1
        cell.Copy Sheets(2).Range("D" & dstRw)
     Next


'Loop through Sheet2 list, extract unique addresses
  lastTmpRw = Sheets(2).Cells(Rows.Count, 4).End(xlUp).Row
     For tmpRw = 1 To lastTmpRw
         If WorksheetFunction.CountIf(Sheets(2).Range("D1:D" & tmpRw), "<>" & "UNASSIGNED<unassigned>") Then
         If WorksheetFunction.CountIf(Sheets(2).Range("D1:D" & tmpRw), Sheets(2).Range("D" & tmpRw)) < 2 Then
                addylist_tmp2 = addylist_tmp2 & Sheets(2).Range("D" & tmpRw).Value & "; "
         End If
         End If
     Next tmpRw


'Clean up temp addylist
     addylist2 = Left(addylist_tmp2, Len(addylist_tmp2) - 2)

</unassigned></unassigned></unassigned></unassigned>

 

[Fluff]

You've got a typo on the 2nd msgbox it should be Plst not P1st (lower case L, rather than number one)

 

[mecerrato]

So sorry, rookie mistake, your code is working perfectly. Thank you so much for your help

 

[Fluff]

You're welcome & thanks for the feedback

 

[mecerrato]

This may be a dumb question but I need to ask.

I will use this in many procedures and I was wondering if there was a way to make it a function to call instead of typing in the code in each procedure?
OR
Should I call it from the other procedures? will the variables carry over?

 

[Fluff]

How about

Function mecerrato(Rng As Range, Optional St As String) As String
   Dim Cl As Range
   Dim Plst As String
   DimPdic As Object
   
   Set Pdic = CreateObject("scripting.dictionary")
      For Each Cl In Rng
         If Cl.Value <> "" And LCase(Cl.Value) <> LCase(St) Then Pdic(Cl.Value) = Empty
      Next Cl
     mecerrato = Join(Pdic.Keys, "; ")
End Function

and called like

Sub test()
   Dim Rng1 As Range, Rng2 As Range
   
   With Sheets("pcode")
      Set Rng1 = .Range("C11", .Range("C" & Rows.Count).End(xlUp))
      Set Rng2 = .Range("E11", .Range("E" & Rows.Count).End(xlUp))
   End With
   MsgBox mecerrato(Rng1)
   MsgBox mecerrato(Rng2, "UNASSIGNED")
End Sub

 

[mecerrato]

@Fluff Thanks but after testing a bit it didn't really make more sense to use as a function but definitely will keep the code for future needs

I have another question kinda related, please let me know if you think I should post as another thread.
I am using a portion of your code to create a list of each unique name of the Mlst list in each row in column B in a sheet called "Validation Data". I wrote a little code to find the next blank row and to write the value in that row and then go to the next one and write the next value but it writes the value to the same row. I think I am missing a for statement somewhere but am not sure.Can you help?
Here is my code:

Sub mecerratoCopyMlst()Dim Cl As Range
Dim Mlst As String
Dim Mdic As Object
   NextRow = Sheets("Validation Data").Range("A" & Rows.Count).End(xlUp).Row
   Sheets("Validation Data").Select
   Range("$A$2:$A$" & NextRow).Select
   Range("$a$2:$a$50").Select
   Selection.ClearContents
   Set Mdic = CreateObject("scripting.dictionary")
   With Sheets("Pipeline")
      For Each Cl In .Range("E11", .Range("E" & Rows.Count).End(xlUp)).SpecialCells(xlVisible)
         If Cl.Value <> "" Then Mdic(Cl.Value) = Empty
         Sheets("Validation Data").Range("A" & NextRow + 1).Value = Cl.Value
      Next Cl
   End With
End Sub

 

[Fluff]

Try

      For Each Cl In .Range("E11", .Range("E" & Rows.Count).End(xlUp)).SpecialCells(xlVisible)
         If Cl.Value <> "" Then 
             Mdic(Cl.Value) = Empty
             Sheets("Validation Data").Range("A" & NextRow + 1).Value = Cl.Value
             nextrow=nextrow+1
         End If
      Next Cl

 

[mecerrato]

This wote the data a bunch of times, didn't work

Sub mecerratoCopyMlst()Dim Cl As Range
Dim Mlst As String
Dim Mdic As Object
   nextrow = Sheets("Validation Data").Range("A" & Rows.Count).End(xlUp).Row
   Sheets("Validation Data").Select
   Range("$A$2:$A$" & nextrow).Select
   Range("$a$2:$a$50").Select
   Selection.ClearContents
   Set Mdic = CreateObject("scripting.dictionary")
   With Sheets("Pipeline")
   For Each Cl In .Range("E11", .Range("E" & Rows.Count).End(xlUp)).SpecialCells(xlVisible)
         If Cl.Value <> "" Then
             Mdic(Cl.Value) = Empty
             Sheets("Validation Data").Range("A" & nextrow + 1).Value = Cl.Value
             nextrow = nextrow + 1
         End If
      Next Cl
   End With
End Sub

 

[Fluff]

Try

   With Sheets("Pipeline")
      For Each Cl In .Range("E11", .Range("E" & Rows.Count).End(xlUp)).SpecialCells(xlVisible)
         If Cl.Value <> "" And Not Mdic.Exists(Cl.Value) Then
             Mdic(Cl.Value) = Empty
             Sheets("Validation Data").Range("A" & NextRow + 1).Value = Cl.Value
             NextRow = NextRow + 1
         End If
      Next Cl

 

[mecerrato]

Thanks, this worked perfectly Posting final code for anyone searching:

Sub CreateLCList()Dim Cl As Range
Dim Mlst As String
Dim Mdic As Object
   NextRow = Sheets("Validation Data").Range("A" & Rows.Count).End(xlUp).Row
   Sheets("Validation Data").Select
   Range("$A$2:$A$" & NextRow).Select
   Range("$a$2:$a$50").Select
   Selection.ClearContents
   Range("A2").Select
   NextRow = Sheets("Validation Data").Range("A" & Rows.Count).End(xlUp).Row
   Set Mdic = CreateObject("scripting.dictionary")
   With Sheets("Pipeline")
      For Each Cl In .Range("E11", .Range("E" & Rows.Count).End(xlUp)).SpecialCells(xlVisible)
         If Cl.Value <> "" And Not Mdic.Exists(Cl.Value) Then
             Mdic(Cl.Value) = Empty
             Sheets("Validation Data").Range("A" & NextRow + 1).Value = Cl.Value
             NextRow = NextRow + 1
         End If
      Next Cl
   End With
   Sheets("Pipeline").Select
   Range("A11").Select
End Sub