how to count repeate words in VBA with msgbox

[dilipgr]

Dear Team,

Good Day,

Ref No	Comp Nature	Date	Time
123	Incoming	30/01/2015	5:37:03 PM
143	South	30/01/2015	5:37:03 PM
1421	Incoming	30/01/2015	6:01:06 PM
1422	Incoming	30/01/2015	6:02:28 PM
1423	South	30/01/2015	6:02:28 PM
1424	South	30/01/2015	6:02:28 PM
1425	Tamilnadu	30/01/2015	6:02:28 PM
1426	Query	30/01/2015	6:02:28 PM
1427	Incoming	30/01/2015	6:02:28 PM
1428	Tamilnadu	30/01/2015	6:02:28 PM
1429	South	30/01/2015	6:02:28 PM
in the above details i want to know how count the repated words in (comp nature) B column in vba with msg box. can any one help me

<colgroup><col><col><col><col></colgroup><tbody>
</tbody>

 

[Tinbendr]

This will display the count of the active cell in column B. So, if your active cell is B2, it will count the number of Incoming in coumn B.

Sub CountActiveCell()
Dim LastRow As Long
Dim Cnt As Long
Dim C As Range
Dim FirstAddress As String
With Worksheets(1)
    LastRow = .Cells(Rows.Count, "B").End(xlUp).Row
    
    With .Range("B1:B" & LastRow)
        Set C = .Find(ActiveCell, LookIn:=xlValues)
        If Not C Is Nothing Then
            FirstAddress = C.Address
            Do
                Cnt = Cnt + 1
                Set C = .FindNext(C)
            Loop While Not C Is Nothing And C.Address <> FirstAddress
        End If
    End With
End With
MsgBox Cnt
End Sub

 

[hiker95]

dilipgr,

1. What version of Excel and Windows are you using?

2. Are you using a PC or a Mac?


I am having a problem putting the results (aligning corectly) in a Message Box. And, I am not sure how much information can be placed in a Message Box.


Here is another macro solution for you to consider (it will only display the results where the number of repeats is greater than 1):

Sample raw data in the active worksheet:

Excel 2007
	A	B	C	D	E	F	G	H
1	Ref No	Comp Nature	Date	Time
2	123	Incoming	30/01/2015	5:37:03 PM
3	143	South	30/01/2015	5:37:03 PM
4	1421	Incoming	30/01/2015	6:01:06 PM
5	1422	Incoming	30/01/2015	6:02:28 PM
6	1423	South	30/01/2015	6:02:28 PM
7	1424	South	30/01/2015	6:02:28 PM
8	1425	Tamilnadu	30/01/2015	6:02:28 PM
9	1426	Query	30/01/2015	6:02:28 PM
10	1427	Incoming	30/01/2015	6:02:28 PM
11	1428	Tamilnadu	30/01/2015	6:02:28 PM
12	1429	South	30/01/2015	6:02:28 PM
13
Sheet1

After the macro:

Excel 2007
	A	B	C	D	E	F	G	H
1	Ref No	Comp Nature	Date	Time			Words	Count
2	123	Incoming	30/01/2015	5:37:03 PM			Incoming	4
3	143	South	30/01/2015	5:37:03 PM			South	4
4	1421	Incoming	30/01/2015	6:01:06 PM			Tamilnadu	2
5	1422	Incoming	30/01/2015	6:02:28 PM
6	1423	South	30/01/2015	6:02:28 PM
7	1424	South	30/01/2015	6:02:28 PM
8	1425	Tamilnadu	30/01/2015	6:02:28 PM
9	1426	Query	30/01/2015	6:02:28 PM
10	1427	Incoming	30/01/2015	6:02:28 PM
11	1428	Tamilnadu	30/01/2015	6:02:28 PM
12	1429	South	30/01/2015	6:02:28 PM
13
Sheet1

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

1. Copy the below code
2. Open your NEW workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Sub CountRepeatWords()
' hiker95, 01/30/2015, ME832519
Dim rng As Range, c As Range, o As Variant, oa As Variant
Dim i As Long, n As Long, m As String
Application.ScreenUpdating = False
oa = Range("A1:D" & Range("A" & Rows.Count).End(xlUp).Row)
Set rng = Range(Range("B2"), Range("B" & Rows.Count).End(xlUp))
With CreateObject("Scripting.Dictionary")
  .CompareMode = vbTextCompare
  For Each c In rng
    If Not .Exists(c.Value) Then
      .Add c.Value, 1
    Else
      .Item(c.Value) = .Item(c.Value) + 1
    End If
  Next
  n = .Count
  o = Application.Transpose(Array(.Keys, .Items))
End With
Columns("G:H").ClearContents
Range("G1").Resize(, 2).Value = Array("Words", "Count")
Range("G2").Resize(UBound(o, 1), UBound(o, 2)) = o
Range("G2:H" & n + 1).Sort key1:=Range("H2"), order1:=2, key2:=Range("G2"), order1:=1
Columns("G:H").AutoFit
On Error Resume Next
With Range("H2:H" & CStr(Range("H" & Rows.Count).End(xlUp).Row))
  .Replace "1", "#NAME?", xlWhole, xlByRows, False
  .SpecialCells(xlCellTypeConstants, xlErrors).EntireRow.Delete xlUp
End With
Range("A1").Resize(UBound(oa, 1), UBound(oa, 2)) = oa
Range("C2:C" & Range("C" & Rows.Count).End(xlUp).Row).NumberFormat = "dd/mm/yyyy"
Range("D2:D" & Range("D" & Rows.Count).End(xlUp).Row).NumberFormat = "[$-F400]h:mm:ss AM/PM"
Application.ScreenUpdating = True
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 CountRepeatWords macro.

 

[Tinbendr]

I realzed after looking at Hiker's response that you wanted it for all instances.

Here is my version.

Sub CountActiveCell2()
Dim Unique As New Collection
Dim LastRow As Long
Dim A As Long
Dim Cnt As Long
Dim C As Range
Dim FirstAddress As String
Dim Msg As String
With Worksheets(1)
    LastRow = .Cells(Rows.Count, "B").End(xlUp).Row
    
    For A = 2 To LastRow
        On Error Resume Next
        Unique.Add CStr(.Range("B" & A)), CStr(.Range("B" & A))
        On Error GoTo 0
    Next
   
    For A = 1 To Unique.Count
    With .Range("B1:B" & LastRow)
        Set C = .Find(Unique(A), LookIn:=xlValues)
        If Not C Is Nothing Then
            FirstAddress = C.Address
            Do
                Cnt = Cnt + 1
                Set C = .FindNext(C)
            Loop While Not C Is Nothing And C.Address <> FirstAddress
            Msg = Msg & Unique(A) & "-" & Cnt & vbCr
            Cnt = 0
        End If
    End With
    Next
End With
MsgBox Msg
End Sub

 

[dilipgr]

Sir

And One More in VBA i'm taking report for performance so i'm creating userform the properties are combobox1, dtpicker1, textbox1 & commandbuttton1.

Station	01/01/2015	02/01/2015	03/01/2015	04/01/2015	05/01/2015	06/01/2015
MON	TUE	WED	THU	FRI	SAT
AKM
APK
ARR
ART
ASD
ATR
BTU
CDM
CGL
CJB
CMM

<colgroup><col><col span="6"></colgroup><tbody>
</tbody>

station in A column is combobox1, dtpicker is date ie, 1/1/15.....5/1/15 if i select combobox1 CJB and dtpicker 3/1/15 then give the value 100 in textbox1 and click commanbutton1 the value of 100 is placed in D13. Can u please help me


regards
Dilipkumar.V
windows7 excel 2007

 

[hiker95]

dilipgr,

When you respond to your helper(s), please use their site ID/username/handle.

This will keep thread clutter to a minimum and make the discussion easier to follow.


In order to continue I will have to see your actual workbook.

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.

 

[hiker95]

Latest request Cross Posted here:

how to use combobox dtpicker


A message to forum cross posters.

Please read this:
http://www.excelguru.ca/node/7

 

[dilipgr]

code	1/1/15	2/1/15	3/1/15	4/1/15
asd
cdm

<tbody>
</tbody>

 

[hiker95]

dilipgr,

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