Count how many times avalue appears

[paulsolar]

Hi All

I'm getting stuck on a friday afternoon, which is never a good time to get stuck.

I have a worksheet (Sheet1) with loads of info in it that I'm trying to produce a regular report from on Sheet2.

What I'm trying to do I can almost get to work.

I want to get all the info from Sheet1 column I and copy it to Sheet2 column A, then in column B of Sheet2 is list the unique values in Sheet2 column A, so far so good.

Where i'm getting stuck is trying to count how many times each entry in column B appears in Sheet2 column A and list it in Sheet2 column C next to the item.

I hope I've explained it correctly.

Any help is greatly appreciated

Cheers

Paul

Private Sub Ininstallers()
Dim ws As Worksheet, ws1 As Worksheet
Dim lastrow As Long


Set ws = Worksheets("Sheet1")
Set ws1 = Worksheets("Sheet2")




    lastrow = ws.Cells(Rows.Count, 9).End(xlUp).Row
    ws.Range("I2", "I" & lastrow).Copy
    ws1.Range("A1").PasteSpecial xlPasteValues
    ws1.Activate
    
GetUniques
    
End Sub




Sub GetUniques()
Dim d As Object, c As Variant, i As Long, lr As Long
Set d = CreateObject("Scripting.Dictionary")
lr = Cells(Rows.Count, 1).End(xlUp).Row
c = Range("A1:A" & lr)
For i = 1 To UBound(c, 1)
  d(c(i, 1)) = 1
Next i
Range("B1").Resize(d.Count) = Application.Transpose(d.keys)
End Sub

 

[Fluff]

How about

Sub GetUniques()
Dim d As Object, c As Variant, i As Long, lr As Long
Set d = CreateObject("Scripting.Dictionary")
lr = Cells(Rows.Count, 1).End(xlUp).Row
c = Range("A1:A" & lr)
For i = 1 To UBound(c, 1)
   If Not d.exists(c(i, 1)) Then
      d.Add c(i, 1), 1
   Else
      d.Item(c(i, 1)) = d.Item(c(i, 1)) + 1
   End If
Next i
Range("B1").Resize(d.Count) = Application.Transpose(d.keys)
Range("C1").Resize(d.Count) = Application.Transpose(d.items)
End Sub

 

[paulsolar]

Hi Fluff

Brilliant thanks, sorted it in one go.

This will make life easy on Monday for me

cheers

Paul

 

[Fluff]

Glad to help & thanks for the feedback