Array help

[SeanJ]

I need help with this problem. I have a column on sheet 1 that with has the following:

Sites

A
A
B
D
A
C
B
D

I need to count for each site and display it on sheet 2 using vba as shown.

Sites

A 3
B 2
C 1
D 2

I have the following code, but I know its going to need an array but I having trouble think on how it is done. Thanks for the help.

BTW the information will always start on row 5, and the number of site will about 20+. I do not know the number of sites.

[vba]Sub test()
Dim i As Integer
Dim x As Integer
Dim c As Integer
Dim stName As String
c = 0
stName = Sheet1.Cells(5, 4).Value
i = Sheet1.Cells.SpecialCells(xlCellTypeLastCell).Row
For x = 5 To i
If stName = Sheet1.Cells(x, 4).Value Then
c = c + 1
End If

Next x
End Sub
[/vba]

[mdmackillop]

Assuming your sites start in A5
[vba]
Option Explicit
Sub ListCount()
Dim Lst As New Collection
Dim cel As Range, i As Long
For Each cel In Range(Cells(5, 1), Cells(5, 1).End(xlDown))
On Error Resume Next
Lst.Add Item:=cel.Text, key:=cel.Text
Next
For i = 1 To Lst.Count
With Sheets(2)
.Cells(i, 1) = Lst(i)
.Cells(i, 2).FormulaR1C1 = "=COUNTIF(Sheet1!C[-1],Sheet2!RC[-1])"
End With
Next i
End Sub

[/vba]

[SeanJ]

Thank for helping but I got this error

run-time error '457'
This key is already associated with an element of this collection

Program stops at this point during the 2nd time through.

[mdmackillop]

Can you try this sample?

[SeanJ]

When I download the xls file and click 'List Count' I get the same error on the same line.

I step through the code and when it comes to the letter 'A' the 2nd time is when the program stops.

[Bob Phillips]

Forget VBA, not needed.

On sheet 2

A1: =Sheet1!A1
A2: =IF(ISERROR(MATCH(0,COUNTIF(A$1:A1,Sheet1!$A$1:$A$20&""),0)),"",
INDEX(IF(ISBLANK(Sheet1!$A$1:$A$20),"",Sheet1!$A$1:$A$20),MATCH(0,COUNTIF(A $1:A1,Sheet1!$A$1:$A$20&""),0)))

which is an array formula, it should be committed with Ctrl-Shift-Enter, not just Enter.

Copy A2 down as far as you might need

B1: =IF(A1<>"",COUNTIF(Sheet1!A:A,A1),"")

and copy down

[SeanJ]

This has to run in VBA

[mdmackillop]

Try this version
[VBA]
Option Explicit
Sub ListCount()
Dim d As Object, a
Dim Lst As New Collection
Dim cel As Range, i As Long
Set d = CreateObject("Scripting.Dictionary")
For Each cel In Range(Cells(5, 1), Cells(5, 1).End(xlDown))
On Error Resume Next
d.Add Item:=cel.Text, key:=cel.Text
Next
a = d.Items
For i = 0 To d.Count - 1
With Sheets(2)
.Cells(i + 1, 1) = a(i)
.Cells(i + 1, 2).FormulaR1C1 = "=COUNTIF(Sheet1!C[-1],Sheet2!RC[-1])"
End With
Next i
End Sub

[/VBA]

[SeanJ]

Sorry same error same spot

[lucas]

I tested both of Malcolms contributions and had no errors and it worked both times....what version of Excel are you using?

[mdmackillop]

A different methodology. You need to add a header above your sites list for this method to work correctly, although you could add to the code to delete this from the results sheet.
[vba]
Sub FilterListCount()
Dim cel As Range
FindUniqueValues Range(Cells(4, 1), Cells(4, 1).End(xlDown)), Sheets(2).Range("A1")
With Sheets(2)
For Each cel In Range(.Cells(2, 1), .Cells(2, 1).End(xlDown))
cel.Offset(, 1).FormulaR1C1 = "=COUNTIF(Sheet1!C[-1],Sheet2!RC[-1])"
Next
End With
End Sub
Sub FindUniqueValues(SourceRange As Range, TargetCell As Range)
SourceRange.AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=TargetCell, Unique:=True
End Sub

[/vba]

[SeanJ]

That works!!!!

How do I get it to that list if it is in Column D instead of A on Sheet1?

I am trying to figure that out, but a helping won't hurt.

Thanks

[SeanJ]

I got it!!!
I got it!!!

Stupid me had to see the "countif" on Sheet2 and made some minor adjustment to the code. Here is the ajusted code.

[vba]Sub FilterListCount()
Dim cel As Range
FindUniqueValues Range(Cells(4, 4), Cells(4, 4).End(xlDown)), Sheets(2).Range("A1")
With Sheets(2)
For Each cel In Range(.Cells(2, 1), .Cells(2, 1).End(xlDown))
cel.Offset(, 1).FormulaR1C1 = "=COUNTIF(Sheet1!C[2],Sheet2!RC[-1])"
Next
End With
End Sub
Sub FindUniqueValues(SourceRange As Range, TargetCell As Range)
SourceRange.AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=TargetCell, Unique:=True
End Sub[/vba]

I must say that was very intersting problem thanks for your help mdmackillop. You are the best.

[matthewspatrick]

Seems to me the easiest solution of all would have been to just make a PivotTable, whether via code or the UI...

[SeanJ]

Hey matthewspatrick how would you have done a pivot table using vba with column D with sites and column E with date as shown below:

Site Date
B 10/3/06
A 10/1/06
C 10/2/06
A 10/1/06
D 10/1/06
D 10/4/06
B 10/4/06
B 10/1/06
B 10/1/06
C 10/1/06
D 10/2/06
D 10/1/06
B 10/2/06
A 10/1/06
A 10/1/06
A 10/3/06

Thanks