Thread: Incrementing based on Pivot Title (count of ____)

How would you determine what is the header row? You could simply use Currentregion but there may have been a good reason for the user to exclude rows above the selected data.

The header row is always the first row on the sheet the user selects their range of interest from. This sheet's first column is the incident date while the rest of the columns have various headers relating to qualitative (and quantitative information but quantitative isn't that useful in tag clouds so I don't see the user running this code on any column of number info) incident information. The user would want to select ranges that exclude rows above the selected data any time they want to summarize incidents in the past but not necessarily the most recent (i.e. summarize incidents 2 months ago when 2 more months of data have been collected above it).

I was thinking it would be easier than dealing with the header problem discussed in the other post by trying to correct any table that was a result of the user not including some recent data in their range selection. I guess the problem your foreseeing or at least made me think of was that it would be difficult to differentiate between a table that did include the recent data (second table shown) and a table of a selected range that only had once occurrence of the contents of the first cell of the range (interpreted as the header by pivot table). This third table looks like this:

	A	B
1	Count of Fog
2	Fog	Total
3	Fatigue	7
4	Aggressive Driving	4
5	Texting	10
6	Drunk Driving	7
8	Grand Total	28

I'm wondering if some check to see if cell A2's (from the pivot) contents are found in the first row of the sheet the user selected the data from and if it is found in the header row the table is correct and must have resulted from the user including the header row in their range selection.

If A2 does not match any of the headers from the incident data sheet where the user selected the range it must either be either table 1 or table 3 from this thread. In which case if it is table 1, 1 should be added to the corresponding count of it's match (i.e. add 1 to the count of drunk driving).

If it is table 3, there is no match of A2 within the pivot because it had been interpreted as the header AND only occurred once within the range. In this case the contents of A2 would need to be placed into the table as well as a corresponding count of 1.

Now if I only knew how to code this, I believe the strategy is sound and the simplest approach possible (although could easily be wrong about it being the simplest approach since my programming is on par with a smart chimp)

Thanks again for your advice and any help you can provide!

A sample workbook would probably make it easier.

Do you expect the final result to still be a live pivot table?

Nope I do not need the pivot table to be live at all, thank you for asking that that's probably very important for coding purposes. Final result will be showing this frequency table (or more likely only the 5 most frequent, their corresponding counts, and a sum of those five counts) alongside a tag cloud which I already have working and displaying on another sheet within the workbook. It will purely just to show the user the frequency counts that are the basis of the tag cloud.

How can I provide the workbook to the thread or should I just email it? I will need a few moments to take out some confidential information.

You can attach it to a post here (Go Advanced - Manage attachments). It will be a few days before I can look at it anyway, so there is no immediate hurry.

If all you want is a top 5 summary, I would not bother with the pivot table. You could use something like this

Sub MakeTable3()

    Dim CloudData As Range
    Dim Pt As PivotTable
    Dim strField As String
    Dim oDic As Object
    Dim varData
    Dim varItems
    Dim varKeys
    Dim n As Long
    Dim wksTable As Worksheet
    Dim lngTop5Count As Long

    Const cstrSHEET_NAME As String = "FreqTable"
    On Error Resume Next

    'Asks user to specify which column of data they wish to summarize
    Set CloudData = Application.InputBox("Please select a range with the incident information you wish to summarize.", _
                                         "Specify Incident Information", Selection.Address, , , , , 8)
    On Error GoTo err_handle
    Application.ScreenUpdating = False

    If Not CloudData Is Nothing Then
        Set oDic = CreateObject("Scripting.Dictionary")
        strField = Cells(1, CloudData.Column).Value
        With CloudData
            If .Row = 1 Then
                varData = .Resize(.Rows.Count - 1).Offset(1).Value
            Else
                varData = .Value
            End If
        End With
        For n = 1 To UBound(varData, 1)
            If Len(varData(n, 1)) > 0 Then
                oDic(CStr(varData(n, 1))) = Val(oDic(CStr(varData(n, 1)))) + 1
            End If
        Next n

        If oDic.Count > 0 Then

            On Error Resume Next
            Application.DisplayAlerts = False
            Sheets(cstrSHEET_NAME).Delete
            Application.DisplayAlerts = True
            On Error GoTo err_handle

            Set wksTable = Sheets.Add
            With wksTable
                .Name = cstrSHEET_NAME
                .Range("A1:B1").Value = Array(strField, "Total")
                varItems = oDic.Items
                varKeys = oDic.Keys
                lngTop5Count = Application.Large(varItems, 5)
                For n = 1 To UBound(varItems)
                    If varItems(n) >= lngTop5Count Then
                        With .Cells(.Rows.Count, "A").End(xlUp).Offset(1)
                            .Value = varKeys(n)
                            .Offset(, 1).Value = varItems(n)
                        End With
                    End If
                Next n
                'Sorts frequency table descending. *has stopped working at some point*
                With .Range("A1").CurrentRegion
                    .Sort .Cells(1, 2), xlDescending
                End With
            End With

            'Call CreateCloud
        End If
    End If

leave:
    Application.ScreenUpdating = True
    Exit Sub
err_handle:
    MsgBox Err.Description
    Resume leave
End Sub

OEGO,

Thank you so much for your continued help on this first off. When running the code you provided I received a message box which simply said "Type Mismatch." However, even so it is creating a sheet named "FreqTable" and placing the correct header in column A and "Total" in column B.

I've stepped through the code to try and pinpoint the issue but all I could really distinguish was that the message was generated at these last couple lines of code:

err_handle:
    MsgBox Err.Description

This is very exciting, and look forward to figuring this "Type Mismatch" message out and getting the rest of the code to carry through. Thanks again for your help this is great learning how to do this and wouldn't be able to do it without forum help like this.

Can you comment out the second on error goto err_handle line and then rerun it and say which line is highlighted. It worked fine in my tests on your sample file.

I commented out the second line and had an interesting unexpected result. It did not error out but instead the selected range (B5:B25) contained the following counts (by my manual count): Drunk Driving: 7, Aggressive Driving: 2, and Texting: 12.

However within the created frequency table on "FreqTable" sheet however there was no "Texting" or corresponding count. Only Drunk Driving and Aggressive Driving were included however their counts were correct. Thanks again for all your help OEGO!

Oh - I had not thought about you having less than 5 items. Can you replace this line

lngTop5Count = Application.Large(varItems, 5)

with this

If oDic.Count > 5 then
   lngTop5Count = Application.Large(varItems, 5)
Else 
   lngTop5Count = 0
End If

and then test it again, please?