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

DataQuestioner

Board Regular
Joined
Sep 12, 2013
Messages
115
ABC
1CELLS WITH TEXT TO BE COUNTEDAlphabetical WORD LIST from Column 'A' CELLSWORD COUNT from Column 'A'
2Test text in hereEven1
3More test text hereFinal1
4Even more text herehere4
5Final test text herein1
6more1
7More1
8test2
10Test1
11text4

<tbody>
</tbody>

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.
 

Excel Facts

Wildcard in VLOOKUP
Use =VLOOKUP("Apple*" to find apple, Apple, or applesauce
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.
 
Upvote 0
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.
 
Upvote 0
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.
 
Upvote 0
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.
 
Upvote 0
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.
 
Upvote 0
DataQuestioner,

Sample raw data:


Excel 2007
ABC
1ALPHABETICAL LISTWORD COUNT
21 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.
32 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.
43 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.
54 Then on the third day Abraham lifted up his eyes, and saw the place afar off.
TEST TEXT


After the macro:


Excel 2007
ABC
1ALPHABETICAL LISTWORD COUNT
21 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.a8
32 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.Abide1
43 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.Abraham19
54 Then on the third day Abraham lifted up his eyes, and saw the place afar off.Abrahams1
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).

Code:
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.
 
Last edited:
Upvote 0
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.
 
Upvote 0
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.
 
Upvote 0

Forum statistics

Threads
1,213,482
Messages
6,113,915
Members
448,532
Latest member
9Kimo3

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top