Count if?

Question

Hi Jan,

Thanks for your time today.

I need to make a reporting macro for my job that will automatically look at the data and put the employee names across the top of another sheet, regardless of how many employees are at a location.

Example: Site 1 has 5 employees Site 2 has 10 employees Site 3 has 7 employees

All of this information would be contained on a column C of the tab called Site1 (or Site2, or Site3).

I want the macro to automatically scan column C, count the number of unique instances of text, and copy each unique instance into the next successive colum from range B1 onwards to the right. I think I need to use CountIf? Can you help?

Answer

I assumed the sheet you want the results to go to is named TargetSheet.

Paste the code below into a normal module:

Sub CopyUniqueNames()

   Dim oCell As Range
   Dim oSht As Worksheet
   Dim oFound As Range
   For Each oSht In Worksheets
       If oSht.Name <> "TargetSheet" Then
           For Each oCell In Intersect(oSht.UsedRange, oSht.Range("C:C"))
               On Error Resume Next
               Set oFound = Nothing
               With Worksheets("TargetSheet")
                   Set oFound = .Range("1:1").Find(What:=oCell.Value, _
                                                   After:=.Range("A1"), _
                                                   LookIn:=xlFormulas, _
                                                   LookAt:=xlWhole, _
                                                   MatchCase:=False)
                   If oFound Is Nothing Then
                       .Cells(1, .Columns.Count).End(xlToLeft).Offset(, 1).Value = oCell.Value
                   End If
               End With
           Next
       End If
   Next

End Sub