Formula for > 1. Listing all unique Words in a Cell Range alphabetically, then > 2. Listing the Total Count for each Word

[DataQuestioner]

[TABLE="class: grid, width: 500, align: center"]
<tbody>[TR]
[TD][/TD]
[TD="align: center"]A[/TD]
[TD="align: center"]B[/TD]
[TD="align: center"]C[/TD]
[/TR]
[TR]
[TD="align: center"]1[/TD]
[TD="align: center"]CELLS WITH TEXT TO BE COUNTED[/TD]
[TD="align: center"]Alphabetical WORD LIST from Column 'A' CELLS[/TD]
[TD="align: center"]WORD COUNT from Column 'A'[/TD]
[/TR]
[TR]
[TD="align: center"]2[/TD]
[TD="align: center"]Test text in here[/TD]
[TD="align: center"]Even[/TD]
[TD="align: center"]1[/TD]
[/TR]
[TR]
[TD="align: center"]3[/TD]
[TD="align: center"]More test text here[/TD]
[TD="align: center"]Final[/TD]
[TD="align: center"]1[/TD]
[/TR]
[TR]
[TD="align: center"]4[/TD]
[TD="align: center"]Even more text here[/TD]
[TD="align: center"]here[/TD]
[TD="align: center"]4[/TD]
[/TR]
[TR]
[TD="align: center"]5[/TD]
[TD="align: center"]Final test text here[/TD]
[TD="align: center"]in[/TD]
[TD="align: center"]1[/TD]
[/TR]
[TR]
[TD="align: center"]6[/TD]
[TD="align: center"][/TD]
[TD="align: center"]more[/TD]
[TD="align: center"]1[/TD]
[/TR]
[TR]
[TD="align: center"]7[/TD]
[TD="align: center"][/TD]
[TD="align: center"]More[/TD]
[TD="align: center"]1[/TD]
[/TR]
[TR]
[TD="align: center"]8[/TD]
[TD="align: center"][/TD]
[TD="align: center"]test[/TD]
[TD="align: center"]2[/TD]
[/TR]
[TR]
[TD="align: center"]10[/TD]
[TD="align: center"][/TD]
[TD="align: center"]Test[/TD]
[TD="align: center"]1[/TD]
[/TR]
[TR]
[TD="align: center"]11[/TD]
[TD="align: center"][/TD]
[TD="align: center"]text[/TD]
[TD="align: center"]4[/TD]
[/TR]
[TR]
[TD="align: center"][/TD]
[TD="align: center"] [/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[/TR]
</tbody>[/TABLE]

This particular Formula Array request may take some explaining...so please be patient with me as I try to detail the problem. If my explanation is not definitive enough then please ask for clarification. OK, here we go >

1. Cells A2:A5 (this could be an range running up to 1000s of cells in the 'A' column) contains the Text that needs to be searched (each cell could contain up to 100 words that will exclusively contain letters - no numbers, symbols or punctuation).
2. I'm looking for a Formula that can search all of the Words in the 'A' column Range, and then list each unique word (case sensitive) as shown in the 'B' column, in alphabetical order.
3. The 'C' column will provide the Word Count for each Word listed in column 'B'.

NOTE: I have tried taking the Words in column 'A' and using the "Data/Text to Columns" command to put each word occurrence in a different cell, and then using the "Filter" command to list each column in alphabetical order, and finally using the "=COUNT" command to total the "Filter" list, but this is too cumbersome and time consuming.

There must be a more efficient way of doing this. Thanks.

 

[hiker95]

DataQuestioner,

Thanks for the feedback.

You are very welcome. Glad I could help.

And, come back anytime.

 

[DataQuestioner]

Hiker95 - I've just run a major test using the Concordance Macro, and it seems my earlier congratulations to you of "perfect" were premature!

I've noticed that the 'B' Column alphabetical search string results are returning words with a question mark in them.

Looking at your macro code, which I'm learning from, I think your "Array(33, 34, 35, 36, 37, 38, 39, 40, 41, 43, 44, 46, 47, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 64, 91, 92, 93, 94, 95, 96, 123, 124, 125, 126, 182)", which I believe are "Dec ASCII" codes for the punctuation, is missing ASCII code "63" for the question mark.

I've amended it myself, and the results string is now returning words without a question mark attached.

You might want to repost the amended Macro in case any other Forum users want to use the "perfect" version.

Thanks.

 

[hiker95]

DataQuestioner,

Thanks for the latest reply.

I've noticed that the 'B' Column alphabetical search string results are returning words with a question mark in them.

When I tested the posted macro with your last dataset, if I left the 63 in the cary array, the macro did some strange things.

There must be a setting my PC that needs to be tweeked?????

Anyway, you found the solution, and, adjusted the macro, and, it now works correctly on your computer. Nice catch, and fix.

 

[DataQuestioner]

Hiker95,

Your previous comment is intriguing...I noticed also that you had left out "42" in the cary array, for an asterisk.

I wondered if the reason you've had a problem with the question mark in the Macro is because both it (63) and the asterisk (42) are wildcards in a Boolean search?
It's gotta be more than a coincidence.

 

[hiker95]

DataQuestioner,

I have a fix/work around for the ? character that works on my PC, and, I would like you to try the ConcordanceV3 macro.

Sample raw data (only showing the first three verses ending with the ? mark in yellow):

Excel 2007
	A	B	C	D
1		ALPHABETICAL LIST	WORD COUNT
2	1 And it came to pass after these things, that God did tempt Abraham, and said unto him, Abraham: and he said, Behold, here I am?
3	2 And he said, Take now thy son, thine only son Isaac, whom thou lovest, and get thee into the land of Moriah; and offer him there for a burnt offering upon one of the mountains which I will tell thee of?
4	3 And Abraham rose up early in the morning, and saddled his ***, and took two of his young men with him, and Isaac his son, and clave the wood for the burnt offering, and rose up, and went unto the place of which God had told him?
5	4 Then on the third day Abraham lifted up his eyes, and saw the place afar off.
6	5 And Abraham said unto his young men, Abide ye here with the ***; and I and the lad will go yonder and worship, and come again to you.
TEST TEXT

After the new macro (with the words am of him in column B displayed in their correct row):

Excel 2007
	A	B	C
1		ALPHABETICAL LIST	WORD COUNT
2	1 And it came to pass after these things, that God did tempt Abraham, and said unto him, Abraham: and he said, Behold, here I am?	a	8
3	2 And he said, Take now thy son, thine only son Isaac, whom thou lovest, and get thee into the land of Moriah; and offer him there for a burnt offering upon one of the mountains which I will tell thee of?	Abide	1
4	3 And Abraham rose up early in the morning, and saddled his ***, and took two of his young men with him, and Isaac his son, and clave the wood for the burnt offering, and rose up, and went unto the place of which God had told him?	Abraham	19
5	4 Then on the third day Abraham lifted up his eyes, and saw the place afar off.	Abrahams	1
6	5 And Abraham said unto his young men, Abide ye here with the ***; and I and the lad will go yonder and worship, and come again to you.	afar	1
12		am	3
85		him	10
131		of	20
TEST TEXT

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

Option Explicit
Sub ConcordanceV3()
' hiker95, 10/29/2013
' http://www.mrexcel.com/forum/excel-questions/735360-formula-1-listing-all-unique-words-cell-range-alphabetically-then-2-listing-total-count-each-word.html
Dim d As Object
Dim ao As Variant, a As Variant, b As Variant, s, cary
Dim i As Long, ii As Long, iii As Long, n As Long, lr As Long
cary = Array(33, 34, 35, 36, 37, 38, 39, 40, 41, 43, 44, 46, 47, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 64, 91, 92, 93, 94, 95, 96, 123, 124, 125, 126, 182)
ao = Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)
Application.DisplayAlerts = False
Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row).Select
For i = LBound(cary) To UBound(cary) Step 1
  On Error Resume Next
  Selection.Replace What:=Chr(cary(i)), Replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
  On Error GoTo 0
Next i
Selection.Replace What:="  ", Replacement:=" ", LookAt:=xlPart, _
  SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
  ReplaceFormat:=False
Application.DisplayAlerts = True
Range("D1").Select
Set d = CreateObject("Scripting.Dictionary")
a = Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)
For i = LBound(a, 1) To UBound(a, 1)
  If Right(a(i, 1), 1) = "?" Then
    a(i, 1) = Left(a(i, 1), Len(a(i, 1)) - 1)
  End If
Next i
For i = LBound(a, 1) To UBound(a, 1)
  If InStr(Trim(a(i, 1)), " ") = 0 Then
    d(a(i, 1)) = 1
  ElseIf InStr(Trim(a(i, 1)), " ") > 0 Then
    s = Split(a(i, 1), " ")
    For iii = LBound(s) To UBound(s)
      If InStr(s(iii), "?") > 0 Then
        s(iii) = Left(s(iii), Len(s(iii)) - 1)
      End If
      d(s(iii)) = 1
    Next iii
  End If
Next i
Range("B2").Resize(d.Count) = Application.Transpose(d.Keys)
lr = Cells(Rows.Count, 2).End(xlUp).Row
With Range("B2:B" & lr)
  .Sort key1:=Range("B2"), order1:=1
  .HorizontalAlignment = xlCenter
End With
b = Range("B2:C" & Range("B" & Rows.Count).End(xlUp).Row)
For ii = 1 To UBound(b, 1)
  n = 0
  For i = 1 To UBound(a, 1)
    s = Split(Trim(a(i, 1)), " ")
    For iii = LBound(s) To UBound(s)
      If Trim(b(ii, 1)) = s(iii) Then n = n + 1
    Next iii
  Next i
  b(ii, 2) = n
Next ii
Range("B2").Resize(UBound(b, 1), UBound(b, 2)) = b
Range("A2").Resize(UBound(ao, 1), UBound(ao, 2)) = ao
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm

Then run the ConcordanceV3 macro.

 

[DataQuestioner]

Hiker95 - I've tried the V3 Macro and it's returning some worrying results!

I think it is removing words from the 'B' column results that are attached to the question mark!

Can you have another look at it?

 

[hiker95]

DataQuestioner,

This has been an interesting project.

And, I have grossly exceeded the normal amount of time I allocate on resolving requests on sites like MrExcel.

One last try.

In order to be able to resolve your problem I will have to see the actual raw data workbook/worksheet that you are running the macro on.

Do not send the workbook/worksheet in a Private Message.


If you are not able to do the above:

Click on the Reply to Thread button, and just put the word BUMP in the post. Then, click on the Post Quick Reply button, and someone else will assist you.

 

[DataQuestioner]

Hiker95 -
Thanks for all of your hard work - it's truly appreciated by me. Your Macro has been a great help.
Since I've already provided you, on Box Net, with an actual Worksheet, I'm not sure what else I can provide to assist you.
Nevertheless, as you've suggested, I will pass the baton on to others because of your time constraints.

Again, thanks VERY much.

BUMP

 

[DataQuestioner]

Bump

 

[DataQuestioner]

Would any MVPs out there like to take on this challenge and improve on Hiker95s Macro?