Occurrence of first two words and next two and so on

[Sak_Guest12]

I have below scenario but i am not sure if this can be extracted applying any formula/function. Please help

Need to find occurrence of first two words in a sentence and then next two and so on.

Example:

These are environmental related issues
These are code related issues

Occurrence:

These are - 2
are environmental - 1
environmental related - 1
related issues - 2
are code - 1
code related - 1

 

[Rick Rothstein]

I have below scenario but i am not sure if this can be extracted applying any formula/function. Please help

Need to find occurrence of first two words in a sentence and then next two and so on.

Example:

These are environmental related issues
These are code related issues

Occurrence:

These are - 2
are environmental - 1
environmental related - 1
related issues - 2
are code - 1
code related - 1

Your "layout" is not entirely clear to me...

1) Is your example text all in one cell or is each line in its own cell?

2) Where is that output supposed to go... each two words in its own cell with the number of occurrences in the next column?

3) Is a VBA solution acceptable?

 

[Sak_Guest12]

Your "layout" is not entirely clear to me...

1) Is your example text all in one cell or is each line in its own cell? In different cells

2) Where is that output supposed to go... each two words in its own cell with the number of occurrences in the next column?

Below is my text in different cells

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD="align: center"]A[/TD]
[/TR]
[TR]
[TD]CC WRM PC SolMan WRM BI Monitoring WRM ABAP ZTD MS INTF Duration[/TD]
[/TR]
[TR]
[TD]CC WRZ SolMan WRM ABAP bpxgbap WRZ reuxeuux File System[/TD]
[/TR]
[TR]
[TD]CC WRW SolMan reuxeuux File System[/TD]
[/TR]
</tbody>[/TABLE]

Output should be like below

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD="align: center"]B[/TD]
[TD="align: center"]C[/TD]
[/TR]
[TR]
[TD]Top occurring 2 words[/TD]
[TD]Top Occurring 3 words[/TD]
[/TR]
[TR]
[TD]SolMan WRM[/TD]
[TD]reuxeuux File System[/TD]
[/TR]
</tbody>[/TABLE]

Note: Counting of words should be from left to right


3) Is a VBA solution acceptable? Yes

 

[Sak_Guest12]

Your "layout" is not entirely clear to me...

1) Is your example text all in one cell or is each line in its own cell? In different cells

2) Where is that output supposed to go... each two words in its own cell with the number of occurrences in the next column?

Below is my text in different cells

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD="align: center"]A[/TD]
[/TR]
[TR]
[TD]CC WRM PC SolMan WRM BI Monitoring WRM ABAP ZTD MS INTF Duration[/TD]
[/TR]
[TR]
[TD]CC WRZ SolMan WRM ABAP bpxgbap WRZ reuxeuux File System[/TD]
[/TR]
[TR]
[TD]CC WRW SolMan reuxeuux File System[/TD]
[/TR]
</tbody>[/TABLE]

Output should be like below

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD="align: center"]B[/TD]
[TD="align: center"]C[/TD]
[/TR]
[TR]
[TD]Top occurring 2 words[/TD]
[TD]Top Occurring 3 words[/TD]
[/TR]
[TR]
[TD]SolMan WRM[/TD]
[TD]reuxeuux File System[/TD]
[/TR]
</tbody>[/TABLE]

Note: Counting of words should be from left to right


3) Is a VBA solution acceptable? Yes


If VBA solution gives the pivot showing all the occurrences , then i can get top occurring 2 or 3 words out of it.

 

[MrIfOnly]

If VBA solution gives the pivot showing all the occurrences , then i can get top occurring 2 or 3 words out of it.

I went this way.

Please try this in a copy of your workbook:

Sub phraseCtr()

Dim phrase As String
Dim lstRow As Integer
Dim lstCol As Integer
Dim r As Integer, c As Integer, x As Integer, y As Integer


Application.DisplayAlerts = False
ActiveWorkbook.Worksheets.Add After:=ActiveSheet


lstRow = Worksheets(1).Range("A1").End(xlDown).Row


Worksheets(1).Range("A1:A" & lstRow).Copy Destination:=ActiveSheet.Range("A1")
ActiveSheet.Range("A1:A" & lstRow).TextToColumns DataType:=xlDelimited, Space:=True, other:=False
Worksheets(1).Columns("B:C").Delete


x = 1
For r = 1 To lstRow
    lstCol = ActiveSheet.Cells(r, 1).End(xlToRight).Column
For c = 1 To lstCol - 1
    phrase = ActiveSheet.Cells(r, c).Value & " " & ActiveSheet.Cells(r, c + 1).Value
    Worksheets(1).Cells(x, 2).Value = phrase
    x = x + 1
Next c
Next r


With Worksheets(1)
    For y = 1 To x - 1
        .Cells(y, 3).Value = Application.WorksheetFunction.CountIf(.Range("B$1:B$" & x), .Range("B" & y).Value)
    Next y


    .Range("B1:C" & y).RemoveDuplicates Columns:=(1), Header:=xlNo
    
    ActiveSheet.Delete
    .Columns(2).AutoFit
    .Activate
End With


Application.DisplayAlerts = True
End Sub

Regards,

CJ

 

[Sak_Guest12]

I went this way.

Please try this in a copy of your workbook:

Sub phraseCtr()

Dim phrase As String
Dim lstRow As Integer
Dim lstCol As Integer
Dim r As Integer, c As Integer, x As Integer, y As Integer


Application.DisplayAlerts = False
ActiveWorkbook.Worksheets.Add After:=ActiveSheet


lstRow = Worksheets(1).Range("A1").End(xlDown).Row


Worksheets(1).Range("A1:A" & lstRow).Copy Destination:=ActiveSheet.Range("A1")
ActiveSheet.Range("A1:A" & lstRow).TextToColumns DataType:=xlDelimited, Space:=True, other:=False
Worksheets(1).Columns("B:C").Delete


x = 1
For r = 1 To lstRow
    lstCol = ActiveSheet.Cells(r, 1).End(xlToRight).Column
For c = 1 To lstCol - 1
    phrase = ActiveSheet.Cells(r, c).Value & " " & ActiveSheet.Cells(r, c + 1).Value
    Worksheets(1).Cells(x, 2).Value = phrase
    x = x + 1
Next c
Next r


With Worksheets(1)
    For y = 1 To x - 1
        .Cells(y, 3).Value = Application.WorksheetFunction.CountIf(.Range("B$1:B$" & x), .Range("B" & y).Value)
    Next y


    .Range("B1:C" & y).RemoveDuplicates Columns:=(1), Header:=xlNo
    
    ActiveSheet.Delete
    .Columns(2).AutoFit
    .Activate
End With


Application.DisplayAlerts = True
End Sub

Regards,

CJ


Thanks a lot. It works

 

[MrIfOnly]

You're welcome. Thanks for the feedback.