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. :banghead: :help

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

[mdmackillop]

Assuming your sites start in A5

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

[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

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

[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.

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

[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 :banghead: had to see the "countif" on Sheet2 and made some minor adjustment to the code. Here is the ajusted code.

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

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

:thumb :clap:

[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