Solved

Word List Pivot table not counting correctly.

Posted on 2013-11-12
11
407 Views
Last Modified: 2013-11-14
Using the following macro to generate word counts of a list of words


Sub MakeWordList(wkbk As Excel.Workbook)
    Dim InputSheet As Worksheet
    Dim WordListSheet As Worksheet
    Dim PuncChars As Variant, x As Variant
    Dim i As Long, r As Long
    Dim txt As String
    Dim wordCnt As Long
    Dim AllWords As Range
    Dim PC As PivotCache
    Dim PT As PivotTable
   
    Application.ScreenUpdating = False
    Set InputSheet = Workbooks("Automated Interview Analysis.xlsm").Sheets("owssvr")
 
    Set WordListSheet = wkbk.Worksheets.Add
    WordListSheet.name = "FreqAll"
    WordListSheet.Range("A1") = "All Words"
    WordListSheet.Range("A1").Font.Bold = True
    InputSheet.Activate
    wordCnt = 2
    PuncChars = Array(".", ",", ";", ":", "'", "!", "#", _
        "$", "%", "&", "(", ")", " - ", "_", "--", "+", _
        "=", "~", "/", "\", "{", "}", "[", "]", """", "?", "*")
    r = 1

'   Loop until blank cell is encountered
    Do While Cells(r, 1) <> ""
'       covert to UPPERCASE
        txt = UCase(Cells(r, 1))
'       Remove punctuation
        For i = 0 To UBound(PuncChars)
            txt = Replace(txt, PuncChars(i), "")
        Next i
'       Remove excess spaces
        txt = WorksheetFunction.Trim(txt)
'       Extract the words
        x = Split(txt)
        For i = 0 To UBound(x)
            WordListSheet.Cells(wordCnt, 1) = x(i)
            wordCnt = wordCnt + 1
        Next i
    r = r + 1
    Loop
   
'   Create pivot table
    WordListSheet.Activate
    Set AllWords = Range("A1").CurrentRegion
    Set PC = ActiveWorkbook.PivotCaches.Add _
        (SourceType:=xlDatabase, _
        SourceData:=AllWords)
    Set PT = PC.CreatePivotTable _
        (TableDestination:=Range("C1"), _
        tableName:="PivotTable1")
    With PT
        .AddDataField .PivotFields("All Words")
        .PivotFields("All Words").Orientation = xlRowField
    End With
End Sub


However, when I create th epivot table.  It puts some words twice with the count and so they need to be further summed.  Any reason this is happening?  Can't figure it out.
0
Comment
Question by:HyperBPP
  • 6
  • 5
11 Comments
 
LVL 85

Accepted Solution

by:
Rory Archibald earned 500 total points
Comment Utility
Hard to be sure without a sample workbook but I suspect you have some non-printing characters that are causing the 'duplicates'.
0
 
LVL 6

Author Comment

by:HyperBPP
Comment Utility
The document is a governemnt FOUO document so I cannot post it.  How would I identify these non-printing characters?
0
 
LVL 85

Expert Comment

by:Rory Archibald
Comment Utility
Start by testing the length of the cells in the pivot table row fields (using the LEN function) and see if they are different.
0
 
LVL 6

Author Comment

by:HyperBPP
Comment Utility
Tested.  They are coming up different.  If I click in a cell they don't appear to be different.  So how do I get rid of the non-printing characters?
0
 
LVL 85

Expert Comment

by:Rory Archibald
Comment Utility
If you edit the cell do there appear to be any trailing or leading spaces? Did the data perhaps come from a web page?
0
Enabling OSINT in Activity Based Intelligence

Activity based intelligence (ABI) requires access to all available sources of data. Recorded Future allows analysts to observe structured data on the open, deep, and dark web.

 
LVL 6

Author Comment

by:HyperBPP
Comment Utility
If edit the cell there are no leading or trailing spaces.  The data came from a MS word document.  I tried the following function that I found online:

Public Function TrimComplete(ByVal sValue As String) As _
        String

        Dim sAns As String
        Dim sWkg As String
        Dim sChar As String
        Dim lLen As Long
        Dim lCtr As Long

        sAns = sValue
        lLen = Len(sValue)

        If lLen > 0 Then
            'Ltrim
            For lCtr = 1 To lLen
                sChar = Mid(sAns, lCtr, 1)
                If (Asc(sChar) > 32) and (Asc(sChar) < 127) Then Exit For
            Next

            sAns = Mid(sAns, lCtr)
            lLen = Len(sAns)

            'Rtrim
            If lLen > 0 Then
                For lCtr = lLen To 1 Step -1
                    sChar = Mid(sAns, lCtr, 1)
                    If (Asc(sChar) > 32) and (Asc(sChar) < 127) Then Exit For
                Next
            End If
            sAns = Left$(sAns, lCtr)
        End If

        TrimComplete = sAns

    End Function

It collapsed a couple of the words.   However, there appear to still be a few non-printable characters after this function runs.  It fixed some of though.
0
 
LVL 85

Expert Comment

by:Rory Archibald
Comment Utility
Can you test this version on a copy of your workbook?

Sub MakeWordList(wkbk As Excel.Workbook)
   Dim strPattern                  As String
   Dim RegExp                      As Object
   Dim InputSheet                  As Worksheet
   Dim WordListSheet               As Worksheet
   Dim x                           As Variant
   Dim i                           As Long
   Dim r                           As Long
   Dim txt                         As String
   Dim wordCnt                     As Long
   Dim AllWords                    As Range
   Dim PC                          As PivotCache
   Dim PT                          As PivotTable

   Application.ScreenUpdating = False
   '    Set InputSheet = Workbooks("Automated Interview Analysis.xlsm").Sheets("owssvr")
   Set InputSheet = ActiveWorkbook.Sheets(1)
   Set WordListSheet = wkbk.Worksheets.Add
   Set RegExp = CreateObject("vbscript.regexp")
   strPattern = "([^A-Za-z0-9 ]+)"
   With RegExp
      .Pattern = strPattern
      .IgnoreCase = False
   End With
   WordListSheet.Name = "FreqAll"
   WordListSheet.Range("A1") = "All Words"
   WordListSheet.Range("A1").Font.Bold = True
   InputSheet.Activate
   r = 1

   '   Loop until blank cell is encountered
   Do While Cells(r, 1) <> ""
      '       covert to UPPERCASE
      txt = UCase(Cells(r, 1).Value)
      '       clean text
      txt = RegExp.Replace(txt, "")
      '       Remove excess spaces
      txt = WorksheetFunction.Trim(txt)
      '       Extract the words
      x = Split(txt)
      For i = 0 To UBound(x)
         WordListSheet.Cells(wordCnt, 1) = x(i)
         wordCnt = wordCnt + 1
      Next i
      r = r + 1
   Loop

   '   Create pivot table
   WordListSheet.Activate
   Set AllWords = Range("A1").CurrentRegion
   Set PC = ActiveWorkbook.PivotCaches.Add _
            (SourceType:=xlDatabase, _
             SourceData:=AllWords)
   Set PT = PC.CreatePivotTable _
            (TableDestination:=Range("C1"), _
             TableName:="PivotTable1")
   With PT
      .AddDataField .PivotFields("All Words")
      .PivotFields("All Words").Orientation = xlRowField
   End With
End Sub

Open in new window

0
 
LVL 6

Author Comment

by:HyperBPP
Comment Utility
Throws and error at line 42.... Application defined or object defined error
0
 
LVL 85

Expert Comment

by:Rory Archibald
Comment Utility
Oops - too much hack and slash. Add back:
wordCnt = 2

Open in new window

before line 28
0
 
LVL 6

Author Comment

by:HyperBPP
Comment Utility
Does only a few words, spits out 1's for those words and then stops.  No errors.  Just very incomplete.
0
 
LVL 6

Author Closing Comment

by:HyperBPP
Comment Utility
This was the case.  Ended up using the Clean() function to recitfy.
0

Featured Post

Highfive Gives IT Their Time Back

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

Join & Write a Comment

Suggested Solutions

Title # Comments Views Activity
Visual Studio: built-in keystroke automation 2 23
Pivot help 3 21
EXCEL Addin problem 7 23
Macro 3 13
Many companies are making the switch from Microsoft to Google Apps (https://www.google.com/work/apps/business/). Use this article to learn more about what Google Apps has to offer and to help if you’re planning on migrating to Google Apps. It is …
The new Microsoft OS looks great, is easier than ever to upgrade to, it is even free.  So what's the catch?  If you don't change the privacy settings, Microsoft will, in accordance with the (EULA) you clicked okay to without reading, collect all the…
This Micro Tutorial demonstrates how to create Excel charts: column, area, line, bar, and scatter charts. Formatting tips are provided as well.
This is Part 3 in a 3-part series on Experts Exchange to discuss error handling in VBA code written for Excel. Part 1 of this series discussed basic error handling code using VBA. http://www.experts-exchange.com/videos/1478/Excel-Error-Handlin…

771 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

12 Experts available now in Live!

Get 1:1 Help Now