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.

 

[DataQuestioner]

Hiker95 - thanks for your V2 UDF in Post #7.

I will try it out shortly and let you know how I get on.

 

[DataQuestioner]

Hiker95 - Brilliant!

That's a great Macro you've written. Thanks a lot.
I don't know how you VBA guys write that code - it's amazing the results that it produces.


I have an amendment request to the problem...!

1. I've noticed that your Macro will list everything in Column 'A' (this could include numbers and punctuation, and not just words)
2. If the Column 'A' Range did contain cells with numbers and/or punctuation, could you amend the Macro to firstly remove the numbers and punctuation, and then run the rest of the Macro as it currently is?

Here's hoping.

 

[DataQuestioner]

Hiker95 - the following list of punctuation characters would be the items that I want to exclude from the 'A' Column...

!""#$%&'()*+,¶./:;< =>?@[\]^_`{|}~

NOTE: I haven't included the basic '-' hyphen character in the exclusion list, as some of the words in Column 'A' might be hyphenated.

 

[hiker95]

DataQuestioner,

Hiker95 - Brilliant!

That's a great Macro you've written. Thanks a lot.
I don't know how you VBA guys write that code - it's amazing the results that it produces.

Thanks for the feedback.

You are very welcome. Glad I could help.

I have an amendment request to the problem...!

1. I've noticed that your Macro will list everything in Column 'A' (this could include numbers and punctuation, and not just words)
2. If the Column 'A' Range did contain cells with numbers and/or punctuation, could you amend the Macro to firstly remove the numbers and punctuation, and then run the rest of the Macro as it currently is?

Hiker95 - the following list of punctuation characters would be the items that I want to exclude from the 'A' Column...

!""#$%&'()*+,¶./:;< =>?@[\]^_`{|}~

The new requests are doable. I would have to see your actual raw data.

You can upload your workbook to Box Net,
sensitive data changed
mark the workbook for sharing
and provide us with a link to your workbook.

 

[DataQuestioner]

Hiker95,
I've sent you the link to Box Net for the Workbook. Enjoy the challenge!

 

[hiker95]

DataQuestioner,

No more Private Messages - please.


1. I can create an array of the original data in column A, and, after the macro, I can put the original data back.

2. Then in the working column A array, you want me to remove the following characters?
[B]!""#$%&'()*+,¶./:;< =>?@[\]^_`{|}~[/B]

3. You do not want me to remove the - character?


4. What about the leading numbers in each verse?

I will have to display screenshots when I finish the new macro.

 

[DataQuestioner]

Hiker95,
Yes, remove the leading numbers in each verse.

Just use a few of the verses in the Workbook I sent you to show screenshots of the finished result.
You dont need to show all 24 verses (the Macro should work the same whether there's 2 cells or 2002 cells!)

Thanks.

 

[hiker95]

DataQuestioner,

Sample raw data:

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.
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.
TEST TEXT

After the macro:

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
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 ConcordanceV2()
' 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)
      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 ConcordanceV2 macro.

 

[DataQuestioner]

Hiker95- that's a mighty impressive piece of programming.

I'm going to try out the Macro now - I will let you know how I get on.

 

[DataQuestioner]

Hiker95 - you've created an outstanding Concordance Macro. I works perfectly.

Thank you very much - I hope that other Forum users appreciate what you've created.