CODING MOD HELP

[BERTRAND]

Hi Folks,
I am using the following code to count the values in column "A". The values in "A" are "Blocks" of data separated by single blank cells. I need the code to evaluate each block separately (because the same entry in "A" may occur in different blocks).
Can the code be modified to achieve this?

Code: Select all

[/list]

Code: Select all

Public Sub CreateSummary()
With CreateObject("Scripting.Dictionary")
    .CompareMode = TextCompare
    For i = 2 To Range("A" & Rows.Count).End(xlUp).Row
        If .Exists(Range("A" & i).Value) Then
            .Item(Range("A" & i).Value) = .Item(Range("A" & i).Value) + 1
        Else
            .Add Range("A" & i).Value, 1
        End If
    Next i
    Range("B1").Resize(1, 2).Value = Array("Value", "Count")
    Range("B2").Resize(.Count, 2).Value = Application.Transpose(Array(.Keys, .Items))
End With
End Sub

A B C
[list] Value Count
Pistol BascLOST Pistol BascLOST 1
RobobarWON RobobarWON 2
BobbisoxLOST BobbisoxLOST 1
RobobarWON MaricoLOST 2
MaricoLOST Cloudy DawnLOST 1
MaricoLOST Farmer FrankLOST 1
Cloudy DawnLOST
Farmer FrankLOST Muir LodgeLOST 6
Bahamian CLOST 2
Muir LodgeLOST BaccalaureateLOST 2
Muir LodgeLOST GetabuzzLOST 3
Muir LodgeLOST Fennell BayWON 4
Bahamian CLOST CalafLOST 1
Bahamian CLOST
Muir LodgeLOST
Muir LodgeLOST
Muir LodgeLOST

BaccalaureateLOST
BaccalaureateLOST

GetabuzzLOST
Fennell BayWON
Fennell BayWON
GetabuzzLOST
Fennell BayWON
Fennell BayWON
CalafLOST

I'm afraid I just can't recreate the spreadsheet columns here. I hope you can understand it.

Bert

[osknows]

What are trying to count exactly, occurrences of Robobar only or RobobarWON & RobobarLOST?

Can you give an example of the output you would expect to see for the first block?

[BERTRAND]

Hi Os
Thanks for taking the time.
Each block is a race. The first block in my example should have a blank space under Farmer Frank.
I am looking to isolate instances in each block where a horse or horses names are NOT duplicated, and whether they won or lost.

So the output from the last block would be:

--------B--------------------C
GetabuzzLOST--------------2
Fennell BayWON-----------4
CalafLOST -----------------1

So Calaf is isolated by dint of being appended with a "1"in column "C". There may be more than one horse appended with a "1".
Bear in mind that the same horse may appear in subsequent blocks. The output should be adjacent to it's corresponding block!

Bert

[BERTRAND]

What are trying to count exactly, occurrences of Robobar only or RobobarWON & RobobarLOST?

Can you give an example of the output you would expect to see for the first block?

Hi Os
I did reply with an example, albeit a bit belated.

Bert

[osknows]

Ideally you should output the data into a single column and have a id to tag group the races. It will make for much easier data processing later on.

The following will output what you require but it's a nasty hack for what should be a simple Excel formula using COUNTIFS in a single column

Code: Select all

Option Explicit


Sub test()
Dim rngToSearch As Range
Dim i As Long, j As Long
Dim count As Long
Dim readArr() As Variant
Dim ws As Worksheet
Dim dict As Object
Dim key As String
Dim startGrpRow As Long
Dim dKey As Variant
Dim writeArr() As Variant
Dim writeInc As Long

    Set ws = Sheet1
    Set rngToSearch = ws.Range("A1:B28")
   
    readArr = rngToSearch.Value2
    count = WorksheetFunction.CountA(rngToSearch)
    ReDim writeArr(1 To count, 1 To 2)
   
    For i = LBound(readArr, 1) To UBound(readArr, 1)

        If i = LBound(readArr, 1) Then
            Set dict = CreateObject("Scripting.Dictionary")
            startGrpRow = i
        ElseIf readArr(i - 1, 1) = "" Or i = UBound(readArr, 1) Then
            For Each dKey In dict
                writeArr(startGrpRow + writeInc, 1) = dKey
                writeArr(startGrpRow + writeInc, 2) = "=COUNTIF(R" & startGrpRow & "C1:R" & i - 2 & "C2,RC[-1])"
                writeInc = writeInc + 1
            Next dKey
            Set dict = CreateObject("Scripting.Dictionary")
            startGrpRow = i
            writeInc = 0
        End If

        For j = LBound(readArr, 2) To UBound(readArr, 2)

            If Len(readArr(i, j)) > 0 Then
                key = readArr(i, j)
                If Not dict.Exists(CStr(key)) Then
                    dict.Add CStr(key), CStr(key)
                End If
            End If
        Next j

    Next i
   
    ws.Range("D1").Resize(UBound(writeArr, 1), UBound(writeArr, 2)).Value = writeArr
End Sub

[BERTRAND]

Thanks Os
"Nasty Hack" or not, I only need to run it occasionally.
I don't believe I have COUNTIFS in 2003.
I have had a copy of 2007 for years, but I have put off installing it because a few people including your good self reckon 2003 is better.

Thanks again
Bert

[alrodopial]

try 2010

imo better by far

[osknows]

I might have said at one point that Excel 2003 is better than 2007 but I agree with alrodopial that Excel2010+ are much much better than earlier versions.

[milfor]

What are the advantages?

[osknows]

The main advantages of Excel 2010+ are more than 65k rows, new functions such as COUNTIFS/SUMIFS/IFERROR etc, algorithms using full ranges are faster (eg cannot use range A:A in Excel 2003 formula and A1:A65000 is slow) and faster and more stable handling of large data.

Excel 2007 much of the graphing object model was buggy or broken and it looks awful.

Excel 2003 was very restrictive in row count and often hangs with large amounts of data. I've heard some arguments that code is faster in 2003 which is true for some code. However, with Betfair API you have window of 200ms between refreshes so there's no real benefit in code speed as it's refresh rates and ping times that count.

[alrodopial]

in 2010 the right mouse button context menu is VERY convenient

[austingrd]

I usually do COUNTIFS. I can guarrantee you that life is way easier in Excel 2010!