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

Tested it and unfortunately didn't notice any difference. It seems to be ignoring whatever is the contents of the first cell in the selected range (i.e. B5:B15 returns a count of 7 for "Drunk Driving" but does not have "Texting" within the table. Thanks again for the continued help OEGO! Also I'm looking at the code now to see how I can make the summary table display adjacent to the html browser (which displays the tag cloud).

That's awesome! Thank you so much OEGO it's working correctly.

The last part of this puzzle is going to be incorporating this table with the tag cloud html browser display in a dashboard type presentation. At the least I would like to display this table on the "Cloud" worksheet adjacent to the tag cloud html browser.

But I was thinking what may be even better for the user would be for the macro to 1) Create the Cloud sheet 2) Create the html browser (and size it as I have on the current "Cloud" sheet) 3) Place the summary table directly adjacent to it so the user can quickly reference the frequencies that back up the tag cloud.

In this way the data set workbook would look the same as it always has until they run the macro which would provide them with a summary dashboard with both the visual representation (tag cloud) and the numeric (summary frequency table) of the data. The tag cloud is currently generated by running the "test" subroutine within the MrExcel Module, however it requires 3 files which I have and can provide but don't believe it'd be necessary to provide as it successfully runs as long as their is a sheet with a specific name (currently "Cloud") that has an html browser present.

If its not possible to create and size an html browser on a sheet perhaps the macro could simply unhide a "Cloud" sheet which already has the html browser sized correctly. Thank you so much once again OEGO for helping me get to this point. If you have any advice on these next steps that would be amazing but you've already done so much! I will start trying to figure out the rest of this (although more posts may be coming in the near future). Thanks again!

So I've had some time to attempt to do what I described in my last post. But for some reason I'm having trouble getting my macros to run with each other. I've set it up so that the macro you (OEGO) helped me with runs first and creates the sheet, frequency table, and now the web browser as well. Then it calls the macro "test" which sends the selection to the "WordCloud" macro which should print the tag cloud to the web browser (it requires a few files which are stored locally on my machine).

I believe the call isn't working correctly as I placed a stop within the test macro and it never paused there. I also placed a message box at the end of the WordCloud macro which stated "Macro Finished," and this also never appeared. I would like to have all three run off of the selection (i.e. do away with the following lines of code:

'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)

The following is the three macros together which I am trying to get to run all at once off a selected range (i.e. highlight range and press play, with no message prompt asking for the user to select the range of interest). I thought I knew how to call a macro (although not too sure about how to pass the selection between macros).

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 = "Incident Summary"
    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
                If oDic.Count > 5 Then
                   lngTop5Count = Application.Large(varItems, 5)
                Else
                   lngTop5Count = 0
                End If
                For n = LBound(varItems) 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.
                With .Range("A1").CurrentRegion
                    .Sort .Cells(1, 2), xlDescending
                End With
            End With

        End If
    End If
    
    ActiveSheet.OLEObjects.Add(ClassType:="Shell.Explorer.2", Link:=False, _
        DisplayAsIcon:=False, Left:=383.25, Top:=45, Width:=324.75, Height:= _
        225).Select
    ActiveSheet.Shapes("WebBrowser1").ScaleWidth 1.480369515, msoFalse, _
        msoScaleFromTopLeft
    ActiveSheet.Shapes("WebBrowser1").ScaleHeight 1.3966666667, msoFalse, _
        msoScaleFromTopLeft
leave:
    Application.ScreenUpdating = True
    Exit Sub
err_handle:
    MsgBox Err.Description
    Resume leave
    
Call test

End Sub

Public Sub test()
'this subroutine produces a tag cloud and places it within the Web Browser contained
'on "Incident Summary" (cstrSHEET_NAME) worksheet. It does this by calling WordCloud
'subroutine which creates the tag cloud using a jscript file stored locally.

 WordCloud Selection
 
End Sub


Sub WordCloud(rngInput As Range)
Dim wbString As String
Dim myFile As String
Dim rngVar As Variant
Dim fnum As Integer
Dim i As Integer

rngVar = Application.Transpose(rngInput.Value)


wbString = "<html>" & vbCr
wbString = wbString & "  <head>"

'wbString = wbString & "    <link rel=""stylesheet"" type=""text/css"" href=""http://visapi-gadgets.googlecode.com/svn/trunk/wordcloud/wc.css""></script>" & vbCr
'wbString = wbString & "    <script type=""text/javascript"" src=""http://visapi-gadgets.googlecode.com/svn/trunk/wordcloud/wc.js""></script>" & vbCr
'wbString = wbString & "    <script type=""text/javascript"" src=""http://www.google.com/jsapi""></script>" & vbCr

wbString = wbString & "    <link rel=""stylesheet"" type=""text/css"" href=""wc.css""></script>" & vbCr
wbString = wbString & "    <script type=""text/javascript"" src=""wcbackup3.js""></script>" & vbCr
wbString = wbString & "    <script type=""text/javascript"" src=""jsapi""></script>" & vbCr

wbString = wbString & "  </head>" & vbCr
wbString = wbString & "  <body>" & vbCr
wbString = wbString & "    <div id=""wcdiv""></div>" & vbCr
wbString = wbString & "    <script type=""text/javascript"">" & vbCr
wbString = wbString & "      google.load('visualization', '1');" & vbCr
wbString = wbString & "      google.setOnLoadCallback(draw);" & vbCr
wbString = wbString & "      function draw() {" & vbCr
wbString = wbString & "        var data = new google.visualization.DataTable();" & vbCr
wbString = wbString & "        data.addColumn('string', 'Text1');" & vbCr
wbString = wbString & "        data.addRows(" & UBound(rngVar) & ");" & vbCr

For i = 1 To UBound(rngVar)
    wbString = wbString & "        data.setCell(" & i - 1 & ", 0,'" & rngVar(i) & "');" & vbCr
Next i

wbString = wbString & "        var outputDiv = document.getElementById('wcdiv');" & vbCr
wbString = wbString & "        var wc = new WordCloud(outputDiv);" & vbCr
wbString = wbString & "        wc.draw(data, null);" & vbCr
wbString = wbString & "      }" & vbCr
wbString = wbString & "    </script>" & vbCr
wbString = wbString & "  </body>" & vbCr
wbString = wbString & "</html>"


myFile = ThisWorkbook.Path & "\WordCloud.htm"
fnum = FreeFile()
Open myFile For Output As fnum
Print #fnum, wbString
Close #fnum


With Sheets("Incident Summary").WebBrowser1
    .Silent = True
    .Navigate (myFile)
    Do
        DoEvents
    Loop Until .ReadyState = READYSTATE_COMPLETE
    .Document.body.Scroll = "no"
End With

MsgBox "Macro Finished."

End Sub